packages feed

purescript 0.13.8 → 0.14.0

raw patch · 813 files changed

+14116/−12562 lines, 813 filesdep +purescript-astdep +purescript-cstdep +regex-basedep −dlistdep −scientificdep ~language-javascriptnew-uploader

Dependencies added: purescript-ast, purescript-cst, regex-base

Dependencies removed: dlist, scientific

Dependency ranges changed: language-javascript

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

CONTRIBUTING.md view
@@ -1,50 +1,55 @@+# Contributing to the PureScript Compiler++## Reporting Issues++When reporting issues, please be aware of the following:++* Please use the appropriate issue template if there is one: filling out all of the sections in the template makes it much easier for us to understand what the problem is and how we might want to address it.+* We prefer to reserve the issue tracker in this repository for tasks which involve work on the compiler. If your report or proposal doesn't involve work on the compiler, please open it on the repository where the work would be done. If you're unsure, you can always ask in [the #purescript channel in FP Slack][] or [Discourse][].+* If you have a question or need help, please ask in [the #purescript channel in FP Slack][] or [Discourse][] instead.+* When submitting feature proposals, please be aware that we prefer to be conservative about adding things to the language/compiler. A feature proposal is much more likely to be accepted if it includes a clear description of the problem it intends to solve, as well as not only a strong justification for why adding the feature will solve that problem, but also for why any existing features or techniques that could be used to solve that problem are insufficient.++We have defined some [Project Values](https://github.com/purescript/governance#project-values) in our organization's governance document; referring to these may help you get a better idea of what is likely to be accepted and what isn't.++## Sending Pull Requests+ Pull requests are encouraged, but please open issues before starting to work on something that you intend to make into a PR, so that we can decide if it is a good fit or not. -## Finding Issues to Work On+### Finding Issues to Work On  If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["new contributor" issues](https://github.com/purescript/purescript/labels/new%20contributor) to get started. -## Pull Requests+### Submitting Your Code -Please follow the following guidelines:+When submitting a pull request, please follow the following guidelines:  - Add at least a test to `tests/purs/passing/` and possibly to `tests/purs/failing/`. - Build the binaries and libs with `stack build` - Make sure that all test suites are passing. Run the test suites with `stack test`.-- Build the core libraries by running the script in `core-tests`.+- Please try to keep changes small and isolated: smaller pull requests which only address one issue are much easier to review.+- For any code change, please append a copyright and licensing notice to the [CONTRIBUTORS.md](CONTRIBUTORS.md) file if your name is not in there already. -## Tests+### Running Tests  Run all test suites with `stack test`. You will need `npm`, `bower` and `node` on your PATH to run the tests. -You can run individual test suites using `stack test --test-arguments="-p-PATTERN"` where `PATTERN` is one of `compiler`, `repl`, `ide`, `docs`, `corefn`,-or `hierarchy`.--To build and run a specific test in `tests/purs/passing/` or `tests/purs/failing/`, add test arguments like so:+You can run individual test suites using `stack test --test-arguments="-p PATTERN"` where `PATTERN` is one of `compiler`, `repl`, `ide`, `docs`, `corefn`, or `hierarchy`. You can also build and run a specific test in `tests/purs/passing/` or `tests/purs/failing/` by using the test's filename as the pattern, e.g.: -`stack test --fast --test-arguments="-p 1110.purs"`+```+stack test --fast --test-arguments="-p 1110.purs"+```  This will run whatever test uses the example file `1110.purs`. -## Code Review--To prevent core libraries from getting broken, every change must be reviewed. A pull request will be merged as long as one other team member has verified the changes.--## Adding Dependencies--Because the PureScript compiler is distributed in binary form, we include-the licenses of all dependencies, including transitive ones, in the LICENSE-file. Therefore, whenever the dependencies change, the LICENSE file should be-updated.+### Adding Dependencies -This can be automated; see the `license-generator/generate.hs` file.+Because the PureScript compiler is distributed in binary form, we include the licenses of all dependencies, including transitive ones, in the LICENSE file. Therefore, whenever the dependencies change, the LICENSE file should be updated. -## Writing Issues+This process can be performed automatically by running `make license-generator`. -- If the issue is actually a question, please consider asking on Reddit, Stack Overflow or IRC first.-- Please include a minimal, repeatable test case with any bug report.+### Getting Pull Requests Merged -## Copyright and Licensing+Sometimes pull requests take a little while to be merged. This is partially because they often have knock-on effects for the rest of the ecosystem, and partially because we want to give core team members time to review and consider changes thoroughly. Please see the organization's [governance document](https://github.com/purescript/governance) for information about when a pull request may be merged. -For any code change, please append a copyright and licensing notice to the [CONTRIBUTORS.md](CONTRIBUTORS.md) file.+[the #purescript channel in FP Slack]: https://functionalprogramming.slack.com/+[Discourse]: https://discourse.purescript.org/
CONTRIBUTORS.md view
@@ -21,6 +21,7 @@ | [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license](http://opensource.org/licenses/MIT) | | [@anthok88](https://github.com/anthok88) | anthoq88 | MIT license | | [@ardumont](https://github.com/ardumont) | Antoine R. Dumont | [MIT license](http://opensource.org/licenses/MIT) |+| [@arrowd](https://github.com/arrowd) | Gleb Popov | [MIT license](http://opensource.org/licenses/MIT) | | [@aspidites](https://github.com/aspidites) | Edwin Marshall | [MIT license](http://opensource.org/licenses/MIT) | | [@bagl](https://github.com/bagl) | Petr Vapenka | [MIT license](http://opensource.org/licenses/MIT) | | [@balajirrao](https://github.com/balajirrao) | Balaji Rao | MIT license |@@ -50,6 +51,7 @@ | [@fehrenbach](https://github.com/fehrenbach) | Stefan Fehrenbach | [MIT license](http://opensource.org/licenses/MIT) | | [@felixSchl](https://github.com/felixSchl) | Felix Schlitter | [MIT license](http://opensource.org/licenses/MIT) | | [@FrigoEU](https://github.com/FrigoEU) | Simon Van Casteren | [MIT license](http://opensource.org/licenses/MIT) |+| [@fsoikin](https://github.com/fsoikin) | Fyodor Soikin | [MIT license](http://opensource.org/licenses/MIT) | | [@garyb](https://github.com/garyb) | Gary Burgess | [MIT license](http://opensource.org/licenses/MIT) | | [@hdgarrood](https://github.com/hdgarrood) | Harry Garrood | [MIT license](http://opensource.org/licenses/MIT) | | [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license](http://opensource.org/licenses/MIT) |@@ -67,6 +69,7 @@ | [@legrostdg](https://github.com/legrostdg) | Félix Sipma | [MIT license](http://opensource.org/licenses/MIT) | | [@LiamGoodacre](https://github.com/LiamGoodacre) | Liam Goodacre | [MIT license](http://opensource.org/licenses/MIT) | | [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license](http://opensource.org/licenses/MIT) |+| [@lunaris](https://github.com/lunaris) | Will Jones | [MIT license](http://opensource.org/licenses/MIT) | | [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license](http://opensource.org/licenses/MIT) | | [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license](http://opensource.org/licenses/MIT) | | [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license](http://opensource.org/licenses/MIT) |@@ -75,6 +78,7 @@ | [@mgmeier](https://github.com/mgmeier) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) | | [@michaelficarra](https://github.com/michaelficarra) | Michael Ficarra | [MIT license](http://opensource.org/licenses/MIT) | | [@MichaelXavier](https://github.com/MichaelXavier) | Michael Xavier | MIT license |+| [@milesfrain](https://github.com/milesfrain) | Miles Frain | [MIT license](http://opensource.org/licenses/MIT) | | [@mjgpy3](https://github.com/mjgpy3) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) | | [@mpietrzak](https://github.com/mpietrzak) | Maciej Pietrzak | [MIT license](http://opensource.org/licenses/MIT) | | [@mrhania](https://github.com/mrhania) | Łukasz Hanuszczak | [MIT license](http://opensource.org/licenses/MIT) |@@ -137,6 +141,8 @@ | [@marcosh](https://github.com/marcosh) | Marco Perone | [MIT license](http://opensource.org/licenses/MIT) | | [@matthew-hilty](https://github.com/matthew-hilty) | Matthew Hilty | [MIT license](http://opensource.org/licenses/MIT) | | [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license](http://opensource.org/licenses/MIT) |+| [@mhmdanas](https://github.com/mhmdanas) | Mohammed Anas | [MIT license](http://opensource.org/licenses/MIT) |+| [@kl0tl](https://github.com/kl0tl) | Cyril Sobierajewicz | [MIT license](http://opensource.org/licenses/MIT) |  ### Contributors using Modified Terms @@ -144,6 +150,7 @@ | :------- | :--- | :------ | | [@charleso](https://github.com/charleso) | Charles O'Farrell | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Charles O'Farrell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | | [@chrissmoak](https://github.com/chrissmoak) | Chris Smoak | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Chris Smoak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |+| [@citizengabe](https://github.com/citizengabe) | Gabe Johnson | All contributions I have or will make using the @citizengabe GitHub account are during employment at [CitizenNet Inc.](#companies) who owns the copyright. All of my existing or future contributions made using the @gabejohnson GitHub account are personal contributions and subject to the terms specified [above](#contributors-using-standard-terms). | | [@dylex](https://github.com/dylex) | Dylan Simon | My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | | [@leighman](http://github.com/leighman) | Jack Leigh | My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). | | [@nagisa](https://github.com/nagisa) | nagisa | I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain. |@@ -153,5 +160,6 @@  | Username | Company | Terms | | :------- | :--- | :------ |+| [@citizennet](https://github.com/citizennet) | CitizenNet Inc. | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright CitizenNet Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@dbenyamin-cn](https://github.com/dbenyamin-cn) | | [@slamdata](https://github.com/slamdata) | SlamData, Inc. | Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - @jdegoes | | [@qfpl](https://github.com/qfpl) | qfpl @ Data61 / CSIRO | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Data61 / CSIRO, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@lightandlight](https://github.com/lightandlight) |
INSTALL.md view
@@ -15,7 +15,7 @@  ## Official prebuilt binaries -Each release comes with prebuilt x86-64 binary bundles for Linux, mac OS, and Windows. Users of other operating systems or architectures will likely need to build the compiler from source; see below.+Each [release](https://github.com/purescript/purescript/releases) comes with prebuilt x86-64 binary bundles for Linux, mac OS, and Windows. Users of other operating systems or architectures will likely need to build the compiler from source; see below.  To install a binary bundle, simply extract it and place the `purs` executable somewhere on your PATH. @@ -46,11 +46,23 @@  The PureScript REPL depends on the `curses` library (via the Haskell package `terminfo`). If you are having difficulty running the compiler, it may be-because the `curses` library is missing.+because the `curses` library is missing. This problem may appear as a `libtinfo`+error:+```+error while loading shared libraries: libtinfo.so.5: cannot open shared object file: No such file or directory+```  On Linux, you will probably need to install `ncurses` manually. On Ubuntu, for example, this can be done by running:+```+$ sudo apt install libtinfo5 libncurses5-dev+``` +## EACCES error++If you encounter this error while trying to install via `npm`: ```-$ sudo apt-get install libncurses5-dev+Error: EACCES: permission denied ```++The best solution is to install [Node.js and npm via a node version manager](https://docs.npmjs.com/downloading-and-installing-node-js-and-npm#using-a-node-version-manager-to-install-nodejs-and-npm). This error is due to permissions issues when installing packages globally. You can read more about this error in npm's guide to [resolving EACCES permissions errors when installing packages globally](https://docs.npmjs.com/getting-started/fixing-npm-permissions).
LICENSE view
@@ -48,6 +48,7 @@   cabal-doctest   case-insensitive   cborg+  cereal   cheapskate   clock   colour@@ -72,7 +73,6 @@   dlist   easy-file   edit-distance-  enclosed-exceptions   entropy   exceptions   fast-logger@@ -85,7 +85,7 @@   happy   hashable   haskeline-  hinotify+  hfsevents   http-date   http-types   http2@@ -122,6 +122,8 @@   process   protolude   psqueues+  purescript-ast+  purescript-cst   random   regex-base   regex-tdfa@@ -132,7 +134,6 @@   semigroupoids   semigroups   serialise-  shelly   simple-sendfile   sourcemap   split@@ -141,8 +142,6 @@   streaming-commons   stringsearch   syb-  system-fileio-  system-filepath   tagged   tagsoup   template-haskell@@ -1334,6 +1333,39 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +cereal LICENSE file:++  Copyright (c) Lennart Kolmodin, Galois, Inc.++  All rights reserved.++  Redistribution and use in source and binary forms, with or without+  modification, are permitted provided that the following conditions+  are met:++  1. Redistributions of source code must retain the above copyright+     notice, this list of conditions and the following disclaimer.++  2. Redistributions in binary form must reproduce the above copyright+     notice, this list of conditions and the following disclaimer in the+     documentation and/or other materials provided with the distribution.++  3. Neither the name of the author nor the names of his contributors+     may be used to endorse or promote products derived from this software+     without specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+  POSSIBILITY OF SUCH DAMAGE.+ cheapskate LICENSE file:    Copyright (c) 2013, John MacFarlane@@ -2060,29 +2092,6 @@   IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT   OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -enclosed-exceptions LICENSE file:--  Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/--  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.- entropy LICENSE file:    Copyright (c) Thomas DuBuisson@@ -2496,38 +2505,38 @@   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -hinotify LICENSE file:+hfsevents LICENSE file: -  Copyright (c) Lennart Kolmodin+  Copyright (c) 2012, Luite Stegeman    All rights reserved.    Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions-  are met:+  modification, are permitted provided that the following conditions are met: -  1. Redistributions of source code must retain the above copyright-     notice, this list of conditions and the following disclaimer.+      * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer. -  2. Redistributions in binary form must reproduce the above copyright-     notice, this list of conditions and the following disclaimer in the-     documentation and/or other materials provided with the distribution.+      * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials provided+        with the distribution. -  3. Neither the name of the author nor the names of his contributors-     may be used to endorse or promote products derived from this software-     without specific prior written permission.+      * Neither the name of Luite Stegeman nor the names of other+        contributors may be used to endorse or promote products derived+        from this software without specific prior written permission. -  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS-  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-  POSSIBILITY OF SUCH DAMAGE.+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  http-date LICENSE file: @@ -4048,39 +4057,6 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -shelly LICENSE file:--  Copyright (c) 2017, Petr Rockai <me@mornfall.net>--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:--      * Redistributions of source code must retain the above copyright-        notice, this list of conditions and the following disclaimer.--      * Redistributions in binary form must reproduce the above-        copyright notice, this list of conditions and the following-        disclaimer in the documentation and/or other materials provided-        with the distribution.--      * Neither the name of Petr Rockai nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.- simple-sendfile LICENSE file:    Copyright (c) 2009, IIJ Innovation Institute Inc.@@ -4390,56 +4366,6 @@     be a definition of the Haskell 98 Foreign Function Interface.    -------------------------------------------------------------------------------system-fileio LICENSE file:--  Copyright (c) 2011 John Millikin--  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.--system-filepath LICENSE file:--  Copyright (c) 2010 John Millikin--  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.  tagged LICENSE file:
README.md view
@@ -12,7 +12,7 @@  ## Resources -- [PureScript book](https://leanpub.com/purescript/read)+- [PureScript book](https://book.purescript.org/) - [Documentation](https://github.com/purescript/documentation) - [Try PureScript](http://try.purescript.org) - [Pursuit Package Index](http://pursuit.purescript.org/)
app/Command/Bundle.hs view
@@ -7,6 +7,8 @@ -- | Bundles compiled PureScript modules for the browser. module Command.Bundle (command) where +import Prelude+ import           Data.Traversable (for) import           Data.Aeson (encode) import           Data.Aeson.Encode.Pretty (confCompare, defConfig, encodePretty', keyOrder)
app/Command/Compile.hs view
@@ -5,6 +5,8 @@  module Command.Compile (command) where +import Prelude+ import           Control.Applicative import           Control.Monad import qualified Data.Aeson as A@@ -24,7 +26,7 @@ import           System.Exit (exitSuccess, exitFailure) import           System.Directory (getCurrentDirectory) import           System.FilePath.Glob (glob)-import           System.IO (hPutStr, hPutStrLn, stderr)+import           System.IO (hPutStr, hPutStrLn, stderr, stdout) import           System.IO.UTF8 (readUTF8FilesT)  data PSCMakeOptions = PSCMakeOptions@@ -39,25 +41,25 @@ printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO () printWarningsAndErrors verbose False warnings errors = do   pwd <- getCurrentDirectory-  cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stderr+  cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stdout   let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose, P.ppeRelativeDirectory = pwd }   when (P.nonEmpty warnings) $-    hPutStrLn stderr (P.prettyPrintMultipleWarnings ppeOpts warnings)+    putStrLn (P.prettyPrintMultipleWarnings ppeOpts warnings)   case errors of     Left errs -> do-      hPutStrLn stderr (P.prettyPrintMultipleErrors ppeOpts errs)+      putStrLn (P.prettyPrintMultipleErrors ppeOpts errs)       exitFailure     Right _ -> return () printWarningsAndErrors verbose True warnings errors = do-  hPutStrLn stderr . LBU8.toString . A.encode $+  putStrLn . LBU8.toString . A.encode $     JSONResult (toJSONErrors verbose P.Warning warnings)                (either (toJSONErrors verbose P.Error) (const []) errors)   either (const exitFailure) (const (return ())) errors  compile :: PSCMakeOptions -> IO () compile PSCMakeOptions{..} = do-  input <- globWarningOnMisses (unless pscmJSONErrors . warnFileTypeNotFound) pscmInput-  when (null input && not pscmJSONErrors) $ do+  input <- globWarningOnMisses warnFileTypeNotFound pscmInput+  when (null input) $ do     hPutStr stderr $ unlines [ "purs compile: No input files."                              , "Usage: For basic information, try the `--help' option."                              ]
app/Command/Docs.hs view
@@ -1,6 +1,8 @@  module Command.Docs (command, infoModList) where +import Prelude+ import           Command.Docs.Html import           Command.Docs.Markdown import           Control.Applicative
app/Command/Docs/Html.hs view
@@ -8,6 +8,8 @@   , writeHtmlModules   ) where +import Prelude+ import           Control.Applicative import           Control.Arrow ((&&&)) import           Control.Monad.Writer
app/Command/Docs/Markdown.hs view
@@ -5,6 +5,8 @@   , writeMarkdownModules   ) where +import Prelude+ import           Data.Text (Text) import qualified Data.Text as T import qualified Language.PureScript as P
app/Command/Graph.hs view
@@ -4,6 +4,8 @@  module Command.Graph (command) where +import Prelude+ import           Control.Applicative (many) import           Control.Monad (unless, when) import qualified Data.Aeson as Json
app/Command/Hierarchy.hs view
@@ -17,6 +17,7 @@  module Command.Hierarchy (command) where +import           Prelude import           Protolude (catMaybes)  import           Control.Applicative (optional)@@ -36,14 +37,14 @@ import           Language.PureScript.Hierarchy (Graph(..), _unDigraph, _unGraphName, typeClasses)  data HierarchyOptions = HierarchyOptions-  { _hierachyInput   :: FilePath+  { _hierarchyInput   :: FilePath   , _hierarchyOutput :: Maybe FilePath   }  parseInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module]) parseInput paths = do   content <- readUTF8FilesT paths-  return $ map snd <$> CST.parseFromFiles id content+  return $ map (snd . snd) <$> CST.parseFromFiles id content  compile :: HierarchyOptions -> IO () compile (HierarchyOptions inputGlob mOutput) = do
app/Command/Ide.hs view
@@ -189,7 +189,7 @@         Left err -> $(logError) err         Right (cmd, h) -> do           case decodeT cmd of-            Just cmd' -> do+            Right cmd' -> do               let message duration =                     "Command "                       <> commandName cmd'@@ -210,10 +210,11 @@                   Right r  -> Aeson.encode r                   Left err -> Aeson.encode err               liftIO (hFlush stdout)-            Nothing -> do-              $(logError) ("Parsing the command failed. Command: " <> cmd)+            Left err -> do+              let errMsg = "Parsing the command failed with:\n" <> err <> "\nCommand: " <> cmd+              $(logError) errMsg               liftIO $ do-                catchGoneHandle (T.hPutStrLn h (encodeT (GeneralError "Error parsing Command.")))+                catchGoneHandle (T.hPutStrLn h (encodeT (GeneralError errMsg)))                 hFlush stdout           liftIO $ catchGoneHandle (hClose h)
app/Command/Publish.hs view
@@ -2,6 +2,8 @@  module Command.Publish (command) where +import Prelude+ import           Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy.Char8 as BL
app/Main.hs view
@@ -7,6 +7,8 @@  module Main where +import Prelude+ import qualified Command.Bundle as Bundle import qualified Command.Compile as Compile import qualified Command.Docs as Docs@@ -27,6 +29,8 @@ main = do     IO.hSetEncoding IO.stdout IO.utf8     IO.hSetEncoding IO.stderr IO.utf8+    IO.hSetBuffering IO.stdout IO.LineBuffering+    IO.hSetBuffering IO.stderr IO.LineBuffering     cmd <- Opts.handleParseResult . execParserPure opts =<< getArgs     cmd   where
app/Version.hs view
@@ -3,6 +3,8 @@  module Version where +import Prelude+ import Data.Version (showVersion) import Paths_purescript as Paths @@ -10,8 +12,15 @@ import qualified Development.GitRev as GitRev #endif +-- Unfortunately, Cabal doesn't support prerelease identifiers on versions. To+-- avoid misleading users who run `purs --version`, we manually add the+-- prerelease identifier here (if any). When releasing a proper version, simply+-- set this to an empty string.+prerelease :: String+prerelease = ""+ versionString :: String-versionString = showVersion Paths.version ++ extra+versionString = showVersion Paths.version ++ prerelease ++ extra   where #ifdef RELEASE   extra = ""
purescript.cabal view
@@ -1,19 +1,24 @@-cabal-version: 1.12-name: purescript-version: 0.13.8-license: BSD3-license-file: LICENSE-copyright: (c) 2013-17 Phil Freeman, (c) 2014-19 Gary Burgess, (c) other contributors (see CONTRIBUTORS.md)-maintainer: Gary Burgess <gary.burgess@gmail.com>, Hardy Jones <jones3.hardy@gmail.com>, Harry Garrood <harry@garrood.me>, Christoph Hegemann <christoph.hegemann1337@gmail.com>, Liam Goodacre <goodacre.liam@gmail.com>, Nathan Faubion <nathan@n-son.com>-author: Phil Freeman <paf31@cantab.net>-stability: experimental-homepage: http://www.purescript.org/-bug-reports: https://github.com/purescript/purescript/issues-synopsis: PureScript Programming Language Compiler+cabal-version:      1.12+name:               purescript+version:            0.14.0+license:            BSD3+license-file:       LICENSE+copyright:+    (c) 2013-17 Phil Freeman, (c) 2014-19 Gary Burgess, (c) other contributors (see CONTRIBUTORS.md)++maintainer:+    Gary Burgess <gary.burgess@gmail.com>, Hardy Jones <jones3.hardy@gmail.com>, Harry Garrood <harry@garrood.me>, Christoph Hegemann <christoph.hegemann1337@gmail.com>, Liam Goodacre <goodacre.liam@gmail.com>, Nathan Faubion <nathan@n-son.com>++author:             Phil Freeman <paf31@cantab.net>+stability:          experimental+homepage:           http://www.purescript.org/+bug-reports:        https://github.com/purescript/purescript/issues+synopsis:           PureScript Programming Language Compiler description:     A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript.-category: Language-build-type: Simple++category:           Language+build-type:         Simple extra-source-files:     app/static/index.html     app/static/index.js@@ -26,11 +31,13 @@     tests/purs/bundle/3727.js     tests/purs/bundle/ObjectShorthand.js     tests/purs/failing/MissingFFIImplementations.js-    tests/purs/passing/2172.js     tests/purs/passing/EffFn.js     tests/purs/passing/FunWithFunDeps.js     tests/purs/passing/PolyLabels.js+    tests/purs/passing/ReExportsExported.js     tests/purs/passing/RowUnion.js+    tests/purs/warning/DeprecatedConstraintInForeignImport.js+    tests/purs/warning/DeprecatedFFIPrime.js     tests/purs/warning/UnnecessaryFFIModule.js     tests/purs/warning/UnusedFFIImplementations.js     tests/purs/bundle/3551.purs@@ -94,6 +101,9 @@     tests/purs/failing/1733/Thingy.purs     tests/purs/failing/1825.purs     tests/purs/failing/1881.purs+    tests/purs/failing/2109-bind.purs+    tests/purs/failing/2109-discard.purs+    tests/purs/failing/2109-negate.purs     tests/purs/failing/2128-class.purs     tests/purs/failing/2128-instance.purs     tests/purs/failing/2197-shouldFail.purs@@ -113,6 +123,7 @@     tests/purs/failing/2874-forall2.purs     tests/purs/failing/2874-wildcard.purs     tests/purs/failing/2947.purs+    tests/purs/failing/3077.purs     tests/purs/failing/3132.purs     tests/purs/failing/3275-BindingGroupErrorPos.purs     tests/purs/failing/3275-DataBindingGroupErrorPos.purs@@ -137,6 +148,40 @@     tests/purs/failing/CannotDeriveNewtypeForData.purs     tests/purs/failing/CaseBinderLengthsDiffer.purs     tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.purs+    tests/purs/failing/CoercibleClosedRowsDoNotUnify.purs+    tests/purs/failing/CoercibleConstrained1.purs+    tests/purs/failing/CoercibleConstrained2.purs+    tests/purs/failing/CoercibleConstrained3.purs+    tests/purs/failing/CoercibleForeign.purs+    tests/purs/failing/CoercibleForeign2.purs+    tests/purs/failing/CoercibleForeign3.purs+    tests/purs/failing/CoercibleHigherKindedData.purs+    tests/purs/failing/CoercibleHigherKindedNewtypes.purs+    tests/purs/failing/CoercibleKindMismatch.purs+    tests/purs/failing/CoercibleNominal.purs+    tests/purs/failing/CoercibleNominalTypeApp.purs+    tests/purs/failing/CoercibleNominalWrapped.purs+    tests/purs/failing/CoercibleNonCanonical1.purs+    tests/purs/failing/CoercibleNonCanonical2.purs+    tests/purs/failing/CoercibleOpenRowsDoNotUnify.purs+    tests/purs/failing/CoercibleRepresentational.purs+    tests/purs/failing/CoercibleRepresentational2.purs+    tests/purs/failing/CoercibleRepresentational3.purs+    tests/purs/failing/CoercibleRepresentational4.purs+    tests/purs/failing/CoercibleRepresentational5.purs+    tests/purs/failing/CoercibleRepresentational6.purs+    tests/purs/failing/CoercibleRepresentational6/N.purs+    tests/purs/failing/CoercibleRepresentational7.purs+    tests/purs/failing/CoercibleRepresentational7/N.purs+    tests/purs/failing/CoercibleRepresentational8.purs+    tests/purs/failing/CoercibleRepresentational8/UnsafeCoerce.purs+    tests/purs/failing/CoercibleRoleMismatch1.purs+    tests/purs/failing/CoercibleRoleMismatch2.purs+    tests/purs/failing/CoercibleRoleMismatch3.purs+    tests/purs/failing/CoercibleRoleMismatch4.purs+    tests/purs/failing/CoercibleRoleMismatch5.purs+    tests/purs/failing/CoercibleUnknownRowTail1.purs+    tests/purs/failing/CoercibleUnknownRowTail2.purs     tests/purs/failing/ConflictingExports.purs     tests/purs/failing/ConflictingExports/A.purs     tests/purs/failing/ConflictingExports/B.purs@@ -154,6 +199,8 @@     tests/purs/failing/ConflictingQualifiedImports2/B.purs     tests/purs/failing/ConstraintFailure.purs     tests/purs/failing/ConstraintInference.purs+    tests/purs/failing/CycleInForeignDataKinds.purs+    tests/purs/failing/CycleInKindDeclaration.purs     tests/purs/failing/DctorOperatorAliasExport.purs     tests/purs/failing/DeclConflictClassCtor.purs     tests/purs/failing/DeclConflictClassSynonym.purs@@ -177,6 +224,7 @@     tests/purs/failing/DuplicateModule.purs     tests/purs/failing/DuplicateModule/M1.purs     tests/purs/failing/DuplicateProperties.purs+    tests/purs/failing/DuplicateRoleDeclaration.purs     tests/purs/failing/DuplicateTypeClass.purs     tests/purs/failing/DuplicateTypeVars.purs     tests/purs/failing/EmptyCase.purs@@ -236,8 +284,10 @@     tests/purs/failing/InstanceSigsIncorrectType.purs     tests/purs/failing/InstanceSigsOrphanTypeDeclaration.purs     tests/purs/failing/IntOutOfRange.purs+    tests/purs/failing/InvalidCoercibleInstanceDeclaration.purs     tests/purs/failing/InvalidDerivedInstance.purs     tests/purs/failing/InvalidDerivedInstance2.purs+    tests/purs/failing/InvalidDerivedInstance3.purs     tests/purs/failing/InvalidOperatorInBinder.purs     tests/purs/failing/KindError.purs     tests/purs/failing/KindStar.purs@@ -255,6 +305,7 @@     tests/purs/failing/MissingFFIImplementations.purs     tests/purs/failing/MissingRecordField.purs     tests/purs/failing/MixedAssociativityError.purs+    tests/purs/failing/MonoKindDataBindingGroup.purs     tests/purs/failing/MPTCs.purs     tests/purs/failing/MultipleErrors.purs     tests/purs/failing/MultipleErrors2.purs@@ -286,6 +337,11 @@     tests/purs/failing/OrphanInstanceNullary/Lib.purs     tests/purs/failing/OrphanInstanceWithDetermined.purs     tests/purs/failing/OrphanInstanceWithDetermined/Lib.purs+    tests/purs/failing/OrphanKindDeclaration1.purs+    tests/purs/failing/OrphanKindDeclaration2.purs+    tests/purs/failing/OrphanRoleDeclaration1.purs+    tests/purs/failing/OrphanRoleDeclaration2.purs+    tests/purs/failing/OrphanRoleDeclaration3.purs     tests/purs/failing/OrphanTypeDecl.purs     tests/purs/failing/OverlapAcrossModules.purs     tests/purs/failing/OverlapAcrossModules/Class.purs@@ -294,6 +350,11 @@     tests/purs/failing/OverlappingBinders.purs     tests/purs/failing/OverlappingInstances.purs     tests/purs/failing/OverlappingVars.purs+    tests/purs/failing/PolykindGeneralizationLet.purs+    tests/purs/failing/PolykindInstanceOverlapping.purs+    tests/purs/failing/PolykindInstantiatedInstance.purs+    tests/purs/failing/PolykindInstantiation.purs+    tests/purs/failing/PossiblyInfiniteCoercibleInstance.purs     tests/purs/failing/PrimModuleReserved.purs     tests/purs/failing/PrimModuleReserved/Prim.purs     tests/purs/failing/PrimRow.purs@@ -301,9 +362,17 @@     tests/purs/failing/PrimSubModuleReserved/Prim_Foobar.purs     tests/purs/failing/ProgrammableTypeErrors.purs     tests/purs/failing/ProgrammableTypeErrorsTypeString.purs+    tests/purs/failing/QualifiedOperators.purs+    tests/purs/failing/QualifiedOperators2.purs+    tests/purs/failing/QuantificationCheckFailure.purs+    tests/purs/failing/QuantificationCheckFailure2.purs+    tests/purs/failing/QuantificationCheckFailure3.purs+    tests/purs/failing/QuantifiedKind.purs     tests/purs/failing/Rank2Types.purs     tests/purs/failing/RequiredHiddenType.purs     tests/purs/failing/Reserved.purs+    tests/purs/failing/RoleDeclarationArityMismatch.purs+    tests/purs/failing/RoleDeclarationArityMismatchForeign.purs     tests/purs/failing/RowConstructors1.purs     tests/purs/failing/RowConstructors2.purs     tests/purs/failing/RowConstructors3.purs@@ -311,10 +380,17 @@     tests/purs/failing/RowInInstanceNotDetermined1.purs     tests/purs/failing/RowInInstanceNotDetermined2.purs     tests/purs/failing/RowLacks.purs+    tests/purs/failing/RowsInKinds.purs+    tests/purs/failing/ScopedKindVariableSynonym.purs     tests/purs/failing/SelfImport.purs     tests/purs/failing/SelfImport/Dummy.purs     tests/purs/failing/SkolemEscape.purs     tests/purs/failing/SkolemEscape2.purs+    tests/purs/failing/SkolemEscapeKinds.purs+    tests/purs/failing/StandaloneKindSignatures1.purs+    tests/purs/failing/StandaloneKindSignatures2.purs+    tests/purs/failing/StandaloneKindSignatures3.purs+    tests/purs/failing/StandaloneKindSignatures4.purs     tests/purs/failing/SuggestComposition.purs     tests/purs/failing/Superclasses1.purs     tests/purs/failing/Superclasses2.purs@@ -323,6 +399,7 @@     tests/purs/failing/TooFewClassInstanceArgs.purs     tests/purs/failing/TopLevelCaseNoArgs.purs     tests/purs/failing/TransitiveDctorExport.purs+    tests/purs/failing/TransitiveDctorExportError.purs     tests/purs/failing/TransitiveKindExport.purs     tests/purs/failing/TransitiveSynonymExport.purs     tests/purs/failing/TypeClasses2.purs@@ -333,35 +410,29 @@     tests/purs/failing/TypedHole2.purs     tests/purs/failing/TypeError.purs     tests/purs/failing/TypeOperatorAliasNoExport.purs+    tests/purs/failing/TypeSynonymCycle.purs     tests/purs/failing/TypeSynonyms.purs-    tests/purs/failing/TypeSynonyms2.purs-    tests/purs/failing/TypeSynonyms3.purs     tests/purs/failing/TypeSynonyms4.purs     tests/purs/failing/TypeSynonyms5.purs+    tests/purs/failing/TypeSynonyms7.purs+    tests/purs/failing/TypeSynonymsOverlappingInstance.purs     tests/purs/failing/TypeWildcards1.purs     tests/purs/failing/TypeWildcards2.purs     tests/purs/failing/TypeWildcards3.purs+    tests/purs/failing/TypeWildcards4.purs     tests/purs/failing/UnderscoreModuleName.purs     tests/purs/failing/UnknownType.purs+    tests/purs/failing/UnsupportedRoleDeclarationTypeClass.purs+    tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.purs+    tests/purs/failing/UnsupportedTypeInKind.purs     tests/purs/failing/UnusableTypeClassMethod.purs     tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs     tests/purs/failing/UnusableTypeClassMethodSynonym.purs     tests/purs/failing/Whitespace1.purs     tests/purs/graph/src/Module.purs     tests/purs/graph/src/Module2.purs+    tests/purs/graph/src/Module3.purs     tests/purs/graph/src/ModuleFailing.purs-    tests/purs/layout/AdoIn.purs-    tests/purs/layout/CaseGuards.purs-    tests/purs/layout/CaseWhere.purs-    tests/purs/layout/ClassHead.purs-    tests/purs/layout/Commas.purs-    tests/purs/layout/Delimiter.purs-    tests/purs/layout/DoLet.purs-    tests/purs/layout/DoOperator.purs-    tests/purs/layout/DoWhere.purs-    tests/purs/layout/IfThenElseDo.purs-    tests/purs/layout/InstanceChainElse.purs-    tests/purs/layout/LetGuards.purs     tests/purs/make/Module.purs     tests/purs/passing/1110.purs     tests/purs/passing/1185.purs@@ -379,7 +450,6 @@     tests/purs/passing/2136.purs     tests/purs/passing/2138.purs     tests/purs/passing/2138/Lib.purs-    tests/purs/passing/2172.purs     tests/purs/passing/2197-1.purs     tests/purs/passing/2197-2.purs     tests/purs/passing/2252.purs@@ -411,6 +481,7 @@     tests/purs/passing/3549.purs     tests/purs/passing/3558-UpToDateDictsForHigherOrderFns.purs     tests/purs/passing/3595.purs+    tests/purs/passing/3830.purs     tests/purs/passing/652.purs     tests/purs/passing/810.purs     tests/purs/passing/862.purs@@ -425,6 +496,7 @@     tests/purs/passing/BindersInFunctions.purs     tests/purs/passing/BindingGroups.purs     tests/purs/passing/BlockString.purs+    tests/purs/passing/BlockStringEdgeCases.purs     tests/purs/passing/CaseInDo.purs     tests/purs/passing/CaseInputWildcard.purs     tests/purs/passing/CaseMultipleExpressions.purs@@ -435,6 +507,9 @@     tests/purs/passing/Church.purs     tests/purs/passing/ClassRefSyntax.purs     tests/purs/passing/ClassRefSyntax/Lib.purs+    tests/purs/passing/Coercible.purs+    tests/purs/passing/Coercible/Lib.purs+    tests/purs/passing/Coercible/Lib2.purs     tests/purs/passing/Collatz.purs     tests/purs/passing/Comparisons.purs     tests/purs/passing/Conditional.purs@@ -481,6 +556,7 @@     tests/purs/passing/FieldConsPuns.purs     tests/purs/passing/FieldPuns.purs     tests/purs/passing/FinalTagless.purs+    tests/purs/passing/ForeignDataInKind.purs     tests/purs/passing/ForeignKind.purs     tests/purs/passing/ForeignKind/Lib.purs     tests/purs/passing/FunctionalDependencies.purs@@ -515,6 +591,7 @@     tests/purs/passing/iota.purs     tests/purs/passing/JSReserved.purs     tests/purs/passing/KindedType.purs+    tests/purs/passing/KindUnificationInSolver.purs     tests/purs/passing/LargeSumType.purs     tests/purs/passing/Let.purs     tests/purs/passing/Let2.purs@@ -522,6 +599,7 @@     tests/purs/passing/LetPattern.purs     tests/purs/passing/LiberalTypeSynonyms.purs     tests/purs/passing/Match.purs+    tests/purs/passing/MinusConstructor.purs     tests/purs/passing/Module.purs     tests/purs/passing/Module/M1.purs     tests/purs/passing/Module/M2.purs@@ -601,6 +679,15 @@     tests/purs/passing/PendingConflictingImports2.purs     tests/purs/passing/PendingConflictingImports2/A.purs     tests/purs/passing/Person.purs+    tests/purs/passing/PolykindBindingGroup1.purs+    tests/purs/passing/PolykindBindingGroup2.purs+    tests/purs/passing/PolykindGeneralization.purs+    tests/purs/passing/PolykindGeneralizationHygiene.purs+    tests/purs/passing/PolykindGeneralizedTypeSynonym.purs+    tests/purs/passing/PolykindInstanceDispatch.purs+    tests/purs/passing/PolykindInstantiatedInstance.purs+    tests/purs/passing/PolykindInstantiation.purs+    tests/purs/passing/PolykindRowCons.purs     tests/purs/passing/PolyLabels.purs     tests/purs/passing/PrimedTypeName.purs     tests/purs/passing/QualifiedAdo.purs@@ -609,8 +696,12 @@     tests/purs/passing/QualifiedDo/IxMonad.purs     tests/purs/passing/QualifiedNames.purs     tests/purs/passing/QualifiedNames/Either.purs+    tests/purs/passing/QualifiedOperators.purs+    tests/purs/passing/QualifiedOperators/Foo.purs     tests/purs/passing/QualifiedQualifiedImports.purs+    tests/purs/passing/QuantifiedKind.purs     tests/purs/passing/Rank2Data.purs+    tests/purs/passing/Rank2Kinds.purs     tests/purs/passing/Rank2Object.purs     tests/purs/passing/Rank2Types.purs     tests/purs/passing/Rank2TypeSynonym.purs@@ -624,6 +715,10 @@     tests/purs/passing/ReExportQualified/A.purs     tests/purs/passing/ReExportQualified/B.purs     tests/purs/passing/ReExportQualified/C.purs+    tests/purs/passing/ReExportsExported.purs+    tests/purs/passing/ReExportsExported/A.purs+    tests/purs/passing/ReExportsExported/B.purs+    tests/purs/passing/ReExportsExported/C.purs     tests/purs/passing/ReservedWords.purs     tests/purs/passing/ResolvableScopeConflict.purs     tests/purs/passing/ResolvableScopeConflict/A.purs@@ -638,6 +733,8 @@     tests/purs/passing/RowNub.purs     tests/purs/passing/RowPolyInstanceContext.purs     tests/purs/passing/RowsInInstanceContext.purs+    tests/purs/passing/RowsInKinds.purs+    tests/purs/passing/RowsInKinds2.purs     tests/purs/passing/RowUnion.purs     tests/purs/passing/RunFnInline.purs     tests/purs/passing/RuntimeScopeIssue.purs@@ -656,6 +753,7 @@     tests/purs/passing/SolvingCompareSymbol.purs     tests/purs/passing/SolvingIsSymbol.purs     tests/purs/passing/SolvingIsSymbol/Lib.purs+    tests/purs/passing/StandaloneKindSignatures.purs     tests/purs/passing/Stream.purs     tests/purs/passing/StringEdgeCases.purs     tests/purs/passing/StringEdgeCases/Records.purs@@ -682,7 +780,14 @@     tests/purs/passing/TypeOperators.purs     tests/purs/passing/TypeOperators/A.purs     tests/purs/passing/TypeSynonymInData.purs+    tests/purs/passing/TypeSynonymInstance.purs+    tests/purs/passing/TypeSynonymInstance2.purs+    tests/purs/passing/TypeSynonymInstance3.purs+    tests/purs/passing/TypeSynonymInstance4.purs+    tests/purs/passing/TypeSynonymInstance5.purs+    tests/purs/passing/TypeSynonymInSuperClass.purs     tests/purs/passing/TypeSynonyms.purs+    tests/purs/passing/TypeSynonymsInKinds.purs     tests/purs/passing/TypeWildcards.purs     tests/purs/passing/TypeWildcardsRecordExtension.purs     tests/purs/passing/TypeWithoutParens.purs@@ -708,14 +813,29 @@     tests/purs/warning/2383.purs     tests/purs/warning/2411.purs     tests/purs/warning/2542.purs+    tests/purs/warning/CoercibleUnusedImport.purs+    tests/purs/warning/CoercibleUnusedImport/N1.purs+    tests/purs/warning/CoercibleUnusedImport/N2.purs+    tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.purs+    tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport/N.purs+    tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.purs+    tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport/N.purs     tests/purs/warning/CustomWarning.purs     tests/purs/warning/CustomWarning2.purs     tests/purs/warning/CustomWarning3.purs     tests/purs/warning/CustomWarning4.purs+    tests/purs/warning/DeprecatedConstraintInForeignImport.purs+    tests/purs/warning/DeprecatedFFIPrime.purs+    tests/purs/warning/DeprecatedForeignImportKind.purs+    tests/purs/warning/DeprecatedImportExportKinds.purs+    tests/purs/warning/DeprecatedImportExportKinds/Lib.purs+    tests/purs/warning/DeprecatedRowKindSyntax.purs     tests/purs/warning/DuplicateExportRef.purs     tests/purs/warning/DuplicateImport.purs     tests/purs/warning/DuplicateImportRef.purs     tests/purs/warning/DuplicateSelectiveImport.purs+    tests/purs/warning/HiddenConstructorsGeneric.purs+    tests/purs/warning/HiddenConstructorsNewtype.purs     tests/purs/warning/HidingImport.purs     tests/purs/warning/ImplicitImport.purs     tests/purs/warning/ImplicitQualifiedImport.purs@@ -724,6 +844,7 @@     tests/purs/warning/Kind-UnusedExplicitImport-2.purs     tests/purs/warning/Kind-UnusedImport.purs     tests/purs/warning/KindReExport.purs+    tests/purs/warning/MissingKindDeclaration.purs     tests/purs/warning/MissingTypeDeclaration.purs     tests/purs/warning/NewtypeInstance.purs     tests/purs/warning/NewtypeInstance2.purs@@ -735,6 +856,7 @@     tests/purs/warning/ShadowedBinderPatternGuard.purs     tests/purs/warning/ShadowedNameParens.purs     tests/purs/warning/ShadowedTypeVar.purs+    tests/purs/warning/UnambiguousQuantifiedKind.purs     tests/purs/warning/UnnecessaryFFIModule.purs     tests/purs/warning/UnusedDctorExplicitImport.purs     tests/purs/warning/UnusedDctorImportAll.purs@@ -782,6 +904,7 @@     tests/purs/docs/output/NotAllCtors/docs.json     tests/purs/docs/output/Prelude/docs.json     tests/purs/docs/output/Prim.Boolean/docs.json+    tests/purs/docs/output/Prim.Coerce/docs.json     tests/purs/docs/output/Prim.Ordering/docs.json     tests/purs/docs/output/Prim.Row/docs.json     tests/purs/docs/output/Prim.RowList/docs.json@@ -816,32 +939,41 @@     tests/purs/publish/basic-example/output/Control.Semigroupoid/docs.json     tests/purs/publish/basic-example/output/Data.Boolean/docs.json     tests/purs/publish/basic-example/output/Data.BooleanAlgebra/docs.json+    tests/purs/publish/basic-example/output/Data.Bounded.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Bounded/docs.json     tests/purs/publish/basic-example/output/Data.CommutativeRing/docs.json     tests/purs/publish/basic-example/output/Data.DivisionRing/docs.json+    tests/purs/publish/basic-example/output/Data.Eq.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Eq/docs.json     tests/purs/publish/basic-example/output/Data.EuclideanRing/docs.json     tests/purs/publish/basic-example/output/Data.Field/docs.json     tests/purs/publish/basic-example/output/Data.Function/docs.json     tests/purs/publish/basic-example/output/Data.Functor/docs.json+    tests/purs/publish/basic-example/output/Data.Generic.Rep/docs.json+    tests/purs/publish/basic-example/output/Data.HeytingAlgebra.Generic/docs.json     tests/purs/publish/basic-example/output/Data.HeytingAlgebra/docs.json     tests/purs/publish/basic-example/output/Data.Monoid.Additive/docs.json     tests/purs/publish/basic-example/output/Data.Monoid.Conj/docs.json     tests/purs/publish/basic-example/output/Data.Monoid.Disj/docs.json     tests/purs/publish/basic-example/output/Data.Monoid.Dual/docs.json     tests/purs/publish/basic-example/output/Data.Monoid.Endo/docs.json+    tests/purs/publish/basic-example/output/Data.Monoid.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Monoid.Multiplicative/docs.json     tests/purs/publish/basic-example/output/Data.Monoid/docs.json     tests/purs/publish/basic-example/output/Data.NaturalTransformation/docs.json     tests/purs/publish/basic-example/output/Data.Newtype/docs.json-    tests/purs/publish/basic-example/output/Data.Ord.Unsafe/docs.json+    tests/purs/publish/basic-example/output/Data.Ord.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Ord/docs.json     tests/purs/publish/basic-example/output/Data.Ordering/docs.json+    tests/purs/publish/basic-example/output/Data.Ring.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Ring/docs.json     tests/purs/publish/basic-example/output/Data.Semigroup.First/docs.json+    tests/purs/publish/basic-example/output/Data.Semigroup.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Semigroup.Last/docs.json     tests/purs/publish/basic-example/output/Data.Semigroup/docs.json+    tests/purs/publish/basic-example/output/Data.Semiring.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Semiring/docs.json+    tests/purs/publish/basic-example/output/Data.Show.Generic/docs.json     tests/purs/publish/basic-example/output/Data.Show/docs.json     tests/purs/publish/basic-example/output/Data.Symbol/docs.json     tests/purs/publish/basic-example/output/Data.Unit/docs.json@@ -855,18 +987,378 @@     tests/purs/publish/basic-example/output/Main/docs.json     tests/purs/publish/basic-example/output/Prelude/docs.json     tests/purs/publish/basic-example/output/Prim.Boolean/docs.json+    tests/purs/publish/basic-example/output/Prim.Coerce/docs.json     tests/purs/publish/basic-example/output/Prim.Ordering/docs.json     tests/purs/publish/basic-example/output/Prim.Row/docs.json     tests/purs/publish/basic-example/output/Prim.RowList/docs.json     tests/purs/publish/basic-example/output/Prim.Symbol/docs.json     tests/purs/publish/basic-example/output/Prim.TypeError/docs.json     tests/purs/publish/basic-example/output/Prim/docs.json-    tests/purs/publish/basic-example/output/PSCI.Support/docs.json     tests/purs/publish/basic-example/output/Record.Unsafe/docs.json+    tests/purs/publish/basic-example/output/Safe.Coerce/docs.json     tests/purs/publish/basic-example/output/Type.Data.Row/docs.json     tests/purs/publish/basic-example/output/Type.Data.RowList/docs.json-    tests/purs/publish/basic-example/resolutions-legacy.json+    tests/purs/publish/basic-example/output/Type.Proxy/docs.json+    tests/purs/publish/basic-example/output/Unsafe.Coerce/docs.json     tests/purs/publish/basic-example/resolutions.json+    tests/purs/failing/1071.out+    tests/purs/failing/1169.out+    tests/purs/failing/1175.out+    tests/purs/failing/1310.out+    tests/purs/failing/1570.out+    tests/purs/failing/1733.out+    tests/purs/failing/1825.out+    tests/purs/failing/1881.out+    tests/purs/failing/2109-bind.out+    tests/purs/failing/2109-discard.out+    tests/purs/failing/2109-negate.out+    tests/purs/failing/2128-class.out+    tests/purs/failing/2128-instance.out+    tests/purs/failing/2197-shouldFail.out+    tests/purs/failing/2197-shouldFail2.out+    tests/purs/failing/2378.out+    tests/purs/failing/2379.out+    tests/purs/failing/2434.out+    tests/purs/failing/2534.out+    tests/purs/failing/2542.out+    tests/purs/failing/2567.out+    tests/purs/failing/2601.out+    tests/purs/failing/2616.out+    tests/purs/failing/2806.out+    tests/purs/failing/2874-forall.out+    tests/purs/failing/2874-forall2.out+    tests/purs/failing/2874-wildcard.out+    tests/purs/failing/2947.out+    tests/purs/failing/3077.out+    tests/purs/failing/3132.out+    tests/purs/failing/3275-BindingGroupErrorPos.out+    tests/purs/failing/3275-DataBindingGroupErrorPos.out+    tests/purs/failing/3335-TypeOpAssociativityError.out+    tests/purs/failing/3405.out+    tests/purs/failing/3549-a.out+    tests/purs/failing/3549.out+    tests/purs/failing/365.out+    tests/purs/failing/3689.out+    tests/purs/failing/438.out+    tests/purs/failing/881.out+    tests/purs/failing/AnonArgument1.out+    tests/purs/failing/AnonArgument2.out+    tests/purs/failing/AnonArgument3.out+    tests/purs/failing/ApostropheModuleName.out+    tests/purs/failing/ArgLengthMismatch.out+    tests/purs/failing/Arrays.out+    tests/purs/failing/ArrayType.out+    tests/purs/failing/AtPatternPrecedence.out+    tests/purs/failing/BindInDo-2.out+    tests/purs/failing/BindInDo.out+    tests/purs/failing/CannotDeriveNewtypeForData.out+    tests/purs/failing/CaseBinderLengthsDiffer.out+    tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.out+    tests/purs/failing/CoercibleClosedRowsDoNotUnify.out+    tests/purs/failing/CoercibleConstrained1.out+    tests/purs/failing/CoercibleConstrained2.out+    tests/purs/failing/CoercibleConstrained3.out+    tests/purs/failing/CoercibleForeign.out+    tests/purs/failing/CoercibleForeign2.out+    tests/purs/failing/CoercibleForeign3.out+    tests/purs/failing/CoercibleHigherKindedData.out+    tests/purs/failing/CoercibleHigherKindedNewtypes.out+    tests/purs/failing/CoercibleKindMismatch.out+    tests/purs/failing/CoercibleNominal.out+    tests/purs/failing/CoercibleNominalTypeApp.out+    tests/purs/failing/CoercibleNominalWrapped.out+    tests/purs/failing/CoercibleNonCanonical1.out+    tests/purs/failing/CoercibleNonCanonical2.out+    tests/purs/failing/CoercibleOpenRowsDoNotUnify.out+    tests/purs/failing/CoercibleRepresentational.out+    tests/purs/failing/CoercibleRepresentational2.out+    tests/purs/failing/CoercibleRepresentational3.out+    tests/purs/failing/CoercibleRepresentational4.out+    tests/purs/failing/CoercibleRepresentational5.out+    tests/purs/failing/CoercibleRepresentational6.out+    tests/purs/failing/CoercibleRepresentational7.out+    tests/purs/failing/CoercibleRepresentational8.out+    tests/purs/failing/CoercibleRoleMismatch1.out+    tests/purs/failing/CoercibleRoleMismatch2.out+    tests/purs/failing/CoercibleRoleMismatch3.out+    tests/purs/failing/CoercibleRoleMismatch4.out+    tests/purs/failing/CoercibleRoleMismatch5.out+    tests/purs/failing/CoercibleUnknownRowTail1.out+    tests/purs/failing/CoercibleUnknownRowTail2.out+    tests/purs/failing/ConflictingExports.out+    tests/purs/failing/ConflictingImports.out+    tests/purs/failing/ConflictingImports/B.out+    tests/purs/failing/ConflictingImports2.out+    tests/purs/failing/ConflictingImports2/B.out+    tests/purs/failing/ConflictingQualifiedImports.out+    tests/purs/failing/ConflictingQualifiedImports2.out+    tests/purs/failing/ConflictingQualifiedImports2/B.out+    tests/purs/failing/ConstraintFailure.out+    tests/purs/failing/ConstraintInference.out+    tests/purs/failing/CycleInForeignDataKinds.out+    tests/purs/failing/CycleInKindDeclaration.out+    tests/purs/failing/DctorOperatorAliasExport.out+    tests/purs/failing/DeclConflictClassCtor.out+    tests/purs/failing/DeclConflictClassSynonym.out+    tests/purs/failing/DeclConflictClassType.out+    tests/purs/failing/DeclConflictCtorClass.out+    tests/purs/failing/DeclConflictCtorCtor.out+    tests/purs/failing/DeclConflictDuplicateCtor.out+    tests/purs/failing/DeclConflictSynonymClass.out+    tests/purs/failing/DeclConflictSynonymType.out+    tests/purs/failing/DeclConflictTypeClass.out+    tests/purs/failing/DeclConflictTypeSynonym.out+    tests/purs/failing/DeclConflictTypeType.out+    tests/purs/failing/DiffKindsSameName.out+    tests/purs/failing/DiffKindsSameName/LibA.out+    tests/purs/failing/Do.out+    tests/purs/failing/DoNotSuggestComposition.out+    tests/purs/failing/DoNotSuggestComposition2.out+    tests/purs/failing/DuplicateDeclarationsInLet.out+    tests/purs/failing/DuplicateInstance.out+    tests/purs/failing/DuplicateModule.out+    tests/purs/failing/DuplicateProperties.out+    tests/purs/failing/DuplicateRoleDeclaration.out+    tests/purs/failing/DuplicateTypeClass.out+    tests/purs/failing/DuplicateTypeVars.out+    tests/purs/failing/EmptyCase.out+    tests/purs/failing/EmptyClass.out+    tests/purs/failing/EmptyDo.out+    tests/purs/failing/ExpectedWildcard.out+    tests/purs/failing/ExportConflictClass.out+    tests/purs/failing/ExportConflictClass/B.out+    tests/purs/failing/ExportConflictClassAndType.out+    tests/purs/failing/ExportConflictClassAndType/B.out+    tests/purs/failing/ExportConflictCtor.out+    tests/purs/failing/ExportConflictType.out+    tests/purs/failing/ExportConflictType/B.out+    tests/purs/failing/ExportConflictTypeOp.out+    tests/purs/failing/ExportConflictValue.out+    tests/purs/failing/ExportConflictValueOp.out+    tests/purs/failing/ExportConflictValueOp/B.out+    tests/purs/failing/ExportExplicit.out+    tests/purs/failing/ExportExplicit1.out+    tests/purs/failing/ExportExplicit2.out+    tests/purs/failing/ExportExplicit3.out+    tests/purs/failing/ExtraneousClassMember.out+    tests/purs/failing/ExtraRecordField.out+    tests/purs/failing/Foldable.out+    tests/purs/failing/Generalization1.out+    tests/purs/failing/Generalization2.out+    tests/purs/failing/ImportExplicit.out+    tests/purs/failing/ImportExplicit/M1.out+    tests/purs/failing/ImportExplicit2.out+    tests/purs/failing/ImportHidingModule.out+    tests/purs/failing/ImportModule.out+    tests/purs/failing/InfiniteKind.out+    tests/purs/failing/InfiniteKind2.out+    tests/purs/failing/InfiniteType.out+    tests/purs/failing/InstanceChainBothUnknownAndMatch.out+    tests/purs/failing/InstanceChainSkolemUnknownMatch.out+    tests/purs/failing/InstanceExport.out+    tests/purs/failing/InstanceSigsBodyIncorrect.out+    tests/purs/failing/InstanceSigsDifferentTypes.out+    tests/purs/failing/InstanceSigsIncorrectType.out+    tests/purs/failing/InstanceSigsOrphanTypeDeclaration.out+    tests/purs/failing/IntOutOfRange.out+    tests/purs/failing/InvalidCoercibleInstanceDeclaration.out+    tests/purs/failing/InvalidDerivedInstance.out+    tests/purs/failing/InvalidDerivedInstance2.out+    tests/purs/failing/InvalidDerivedInstance3.out+    tests/purs/failing/InvalidOperatorInBinder.out+    tests/purs/failing/KindError.out+    tests/purs/failing/KindStar.out+    tests/purs/failing/LacksWithSubGoal.out+    tests/purs/failing/LeadingZeros1.out+    tests/purs/failing/LeadingZeros2.out+    tests/purs/failing/Let.out+    tests/purs/failing/LetPatterns1.out+    tests/purs/failing/LetPatterns2.out+    tests/purs/failing/LetPatterns3.out+    tests/purs/failing/LetPatterns4.out+    tests/purs/failing/MissingClassExport.out+    tests/purs/failing/MissingClassMember.out+    tests/purs/failing/MissingClassMemberExport.out+    tests/purs/failing/MissingFFIImplementations.out+    tests/purs/failing/MissingRecordField.out+    tests/purs/failing/MixedAssociativityError.out+    tests/purs/failing/MonoKindDataBindingGroup.out+    tests/purs/failing/MPTCs.out+    tests/purs/failing/MultipleErrors.out+    tests/purs/failing/MultipleErrors2.out+    tests/purs/failing/MultipleTypeOpFixities.out+    tests/purs/failing/MultipleValueOpFixities.out+    tests/purs/failing/MutRec.out+    tests/purs/failing/MutRec2.out+    tests/purs/failing/NewtypeInstance.out+    tests/purs/failing/NewtypeInstance2.out+    tests/purs/failing/NewtypeInstance3.out+    tests/purs/failing/NewtypeInstance4.out+    tests/purs/failing/NewtypeInstance5.out+    tests/purs/failing/NewtypeInstance6.out+    tests/purs/failing/NewtypeMultiArgs.out+    tests/purs/failing/NewtypeMultiCtor.out+    tests/purs/failing/NonAssociativeError.out+    tests/purs/failing/NonExhaustivePatGuard.out+    tests/purs/failing/NullaryAbs.out+    tests/purs/failing/Object.out+    tests/purs/failing/OperatorAliasNoExport.out+    tests/purs/failing/OperatorAt.out+    tests/purs/failing/OperatorBackslash.out+    tests/purs/failing/OperatorSections.out+    tests/purs/failing/OrphanInstance.out+    tests/purs/failing/OrphanInstance/Class.out+    tests/purs/failing/OrphanInstanceFunDepCycle.out+    tests/purs/failing/OrphanInstanceFunDepCycle/Lib.out+    tests/purs/failing/OrphanInstanceNullary.out+    tests/purs/failing/OrphanInstanceNullary/Lib.out+    tests/purs/failing/OrphanInstanceWithDetermined.out+    tests/purs/failing/OrphanInstanceWithDetermined/Lib.out+    tests/purs/failing/OrphanKindDeclaration1.out+    tests/purs/failing/OrphanKindDeclaration2.out+    tests/purs/failing/OrphanRoleDeclaration1.out+    tests/purs/failing/OrphanRoleDeclaration2.out+    tests/purs/failing/OrphanRoleDeclaration3.out+    tests/purs/failing/OrphanTypeDecl.out+    tests/purs/failing/OverlapAcrossModules.out+    tests/purs/failing/OverlapAcrossModules/Class.out+    tests/purs/failing/OverlappingArguments.out+    tests/purs/failing/OverlappingBinders.out+    tests/purs/failing/OverlappingInstances.out+    tests/purs/failing/OverlappingVars.out+    tests/purs/failing/PolykindGeneralizationLet.out+    tests/purs/failing/PolykindInstanceOverlapping.out+    tests/purs/failing/PolykindInstantiatedInstance.out+    tests/purs/failing/PolykindInstantiation.out+    tests/purs/failing/PossiblyInfiniteCoercibleInstance.out+    tests/purs/failing/PrimModuleReserved.out+    tests/purs/failing/PrimRow.out+    tests/purs/failing/PrimSubModuleReserved.out+    tests/purs/failing/PrimSubModuleReserved/Prim_Foobar.out+    tests/purs/failing/ProgrammableTypeErrors.out+    tests/purs/failing/ProgrammableTypeErrorsTypeString.out+    tests/purs/failing/QualifiedOperators.out+    tests/purs/failing/QualifiedOperators2.out+    tests/purs/failing/QuantificationCheckFailure.out+    tests/purs/failing/QuantificationCheckFailure2.out+    tests/purs/failing/QuantificationCheckFailure3.out+    tests/purs/failing/QuantifiedKind.out+    tests/purs/failing/Rank2Types.out+    tests/purs/failing/RequiredHiddenType.out+    tests/purs/failing/Reserved.out+    tests/purs/failing/RoleDeclarationArityMismatch.out+    tests/purs/failing/RoleDeclarationArityMismatchForeign.out+    tests/purs/failing/RowConstructors1.out+    tests/purs/failing/RowConstructors2.out+    tests/purs/failing/RowConstructors3.out+    tests/purs/failing/RowInInstanceNotDetermined0.out+    tests/purs/failing/RowInInstanceNotDetermined1.out+    tests/purs/failing/RowInInstanceNotDetermined2.out+    tests/purs/failing/RowLacks.out+    tests/purs/failing/RowsInKinds.out+    tests/purs/failing/ScopedKindVariableSynonym.out+    tests/purs/failing/SelfImport.out+    tests/purs/failing/SelfImport/Dummy.out+    tests/purs/failing/SkolemEscape.out+    tests/purs/failing/SkolemEscape2.out+    tests/purs/failing/SkolemEscapeKinds.out+    tests/purs/failing/StandaloneKindSignatures1.out+    tests/purs/failing/StandaloneKindSignatures2.out+    tests/purs/failing/StandaloneKindSignatures3.out+    tests/purs/failing/StandaloneKindSignatures4.out+    tests/purs/failing/SuggestComposition.out+    tests/purs/failing/Superclasses1.out+    tests/purs/failing/Superclasses2.out+    tests/purs/failing/Superclasses3.out+    tests/purs/failing/Superclasses5.out+    tests/purs/failing/TooFewClassInstanceArgs.out+    tests/purs/failing/TopLevelCaseNoArgs.out+    tests/purs/failing/TransitiveDctorExport.out+    tests/purs/failing/TransitiveDctorExportError.out+    tests/purs/failing/TransitiveKindExport.out+    tests/purs/failing/TransitiveSynonymExport.out+    tests/purs/failing/TypeClasses2.out+    tests/purs/failing/TypedBinders.out+    tests/purs/failing/TypedBinders2.out+    tests/purs/failing/TypedBinders3.out+    tests/purs/failing/TypedHole.out+    tests/purs/failing/TypedHole2.out+    tests/purs/failing/TypeError.out+    tests/purs/failing/TypeOperatorAliasNoExport.out+    tests/purs/failing/TypeSynonymCycle.out+    tests/purs/failing/TypeSynonyms.out+    tests/purs/failing/TypeSynonyms4.out+    tests/purs/failing/TypeSynonyms5.out+    tests/purs/failing/TypeSynonyms7.out+    tests/purs/failing/TypeSynonymsOverlappingInstance.out+    tests/purs/failing/TypeWildcards1.out+    tests/purs/failing/TypeWildcards2.out+    tests/purs/failing/TypeWildcards3.out+    tests/purs/failing/TypeWildcards4.out+    tests/purs/failing/UnderscoreModuleName.out+    tests/purs/failing/UnknownType.out+    tests/purs/failing/UnsupportedRoleDeclarationTypeClass.out+    tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.out+    tests/purs/failing/UnsupportedTypeInKind.out+    tests/purs/failing/UnusableTypeClassMethod.out+    tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out+    tests/purs/failing/UnusableTypeClassMethodSynonym.out+    tests/purs/failing/Whitespace1.out+    tests/purs/warning/2140.out+    tests/purs/warning/2383.out+    tests/purs/warning/2411.out+    tests/purs/warning/2542.out+    tests/purs/warning/CoercibleUnusedImport.out+    tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.out+    tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.out+    tests/purs/warning/CustomWarning.out+    tests/purs/warning/CustomWarning2.out+    tests/purs/warning/CustomWarning3.out+    tests/purs/warning/CustomWarning4.out+    tests/purs/warning/DeprecatedConstraintInForeignImport.out+    tests/purs/warning/DeprecatedFFIPrime.out+    tests/purs/warning/DeprecatedForeignImportKind.out+    tests/purs/warning/DeprecatedImportExportKinds.out+    tests/purs/warning/DeprecatedRowKindSyntax.out+    tests/purs/warning/DuplicateExportRef.out+    tests/purs/warning/DuplicateImport.out+    tests/purs/warning/DuplicateImportRef.out+    tests/purs/warning/DuplicateSelectiveImport.out+    tests/purs/warning/HiddenConstructorsGeneric.out+    tests/purs/warning/HiddenConstructorsNewtype.out+    tests/purs/warning/HidingImport.out+    tests/purs/warning/ImplicitImport.out+    tests/purs/warning/ImplicitQualifiedImport.out+    tests/purs/warning/ImplicitQualifiedImportReExport.out+    tests/purs/warning/Kind-UnusedExplicitImport-1.out+    tests/purs/warning/Kind-UnusedExplicitImport-2.out+    tests/purs/warning/Kind-UnusedImport.out+    tests/purs/warning/KindReExport.out+    tests/purs/warning/MissingKindDeclaration.out+    tests/purs/warning/MissingTypeDeclaration.out+    tests/purs/warning/NewtypeInstance.out+    tests/purs/warning/NewtypeInstance2.out+    tests/purs/warning/NewtypeInstance3.out+    tests/purs/warning/NewtypeInstance4.out+    tests/purs/warning/OverlappingPattern.out+    tests/purs/warning/ScopeShadowing.out+    tests/purs/warning/ScopeShadowing2.out+    tests/purs/warning/ShadowedBinderPatternGuard.out+    tests/purs/warning/ShadowedNameParens.out+    tests/purs/warning/ShadowedTypeVar.out+    tests/purs/warning/UnambiguousQuantifiedKind.out+    tests/purs/warning/UnnecessaryFFIModule.out+    tests/purs/warning/UnusedDctorExplicitImport.out+    tests/purs/warning/UnusedDctorImportAll.out+    tests/purs/warning/UnusedDctorImportExplicit.out+    tests/purs/warning/UnusedExplicitImport.out+    tests/purs/warning/UnusedExplicitImportTypeOp.out+    tests/purs/warning/UnusedExplicitImportValOp.out+    tests/purs/warning/UnusedFFIImplementations.out+    tests/purs/warning/UnusedImport.out+    tests/purs/warning/UnusedTypeVar.out+    tests/purs/warning/WildcardInferredType.out+    tests/purs/warning/WildcardInferredType2.out     tests/json-compat/v0.11.3/generics-4.0.0.json     tests/json-compat/v0.11.3/symbols-3.0.0.json     tests/json-compat/v0.12.1/typelevel-prelude-3.0.0.json@@ -878,6 +1370,7 @@     tests/support/psci/InteractivePrint.purs     tests/support/psci/Reload.purs     tests/support/psci/Reload.edit+    tests/support/pscide/src/CompletionSpec.purs     tests/support/pscide/src/CompletionSpecDocs.purs     tests/support/pscide/src/FindUsage.purs     tests/support/pscide/src/FindUsage/Definition.purs@@ -902,35 +1395,27 @@     CONTRIBUTING.md  source-repository head-    type: git+    type:     git     location: https://github.com/purescript/purescript  flag release     description:         Mark this build as a release build: prevents inclusion of extra info e.g. commit SHA in --version output)-    default: False +    default:     False+ library     exposed-modules:         Control.Monad.Logger-        Control.Monad.Supply-        Control.Monad.Supply.Class         Language.PureScript-        Language.PureScript.AST-        Language.PureScript.AST.Binders-        Language.PureScript.AST.Declarations-        Language.PureScript.AST.Exported-        Language.PureScript.AST.Literals-        Language.PureScript.AST.Operators-        Language.PureScript.AST.SourcePos-        Language.PureScript.AST.Traversals         Language.PureScript.Bundle         Language.PureScript.CodeGen         Language.PureScript.CodeGen.JS         Language.PureScript.CodeGen.JS.Common         Language.PureScript.CodeGen.JS.Printer-        Language.PureScript.Comments-        Language.PureScript.Constants+        Language.PureScript.Constants.Data.Generic.Rep+        Language.PureScript.Constants.Data.Newtype+        Language.PureScript.Constants.Prelude         Language.PureScript.CoreFn         Language.PureScript.CoreFn.Ann         Language.PureScript.CoreFn.Binders@@ -951,20 +1436,7 @@         Language.PureScript.CoreImp.Optimizer.MagicDo         Language.PureScript.CoreImp.Optimizer.TCO         Language.PureScript.CoreImp.Optimizer.Unused-        Language.PureScript.Crash         Language.PureScript.CST-        Language.PureScript.CST.Convert-        Language.PureScript.CST.Errors-        Language.PureScript.CST.Layout-        Language.PureScript.CST.Lexer-        Language.PureScript.CST.Monad-        Language.PureScript.CST.Parser-        Language.PureScript.CST.Positions-        Language.PureScript.CST.Print-        Language.PureScript.CST.Traversals-        Language.PureScript.CST.Traversals.Type-        Language.PureScript.CST.Types-        Language.PureScript.CST.Utils         Language.PureScript.Docs         Language.PureScript.Docs.AsHtml         Language.PureScript.Docs.AsMarkdown@@ -976,13 +1448,11 @@         Language.PureScript.Docs.Prim         Language.PureScript.Docs.Render         Language.PureScript.Docs.RenderedCode-        Language.PureScript.Docs.RenderedCode.RenderKind         Language.PureScript.Docs.RenderedCode.RenderType         Language.PureScript.Docs.RenderedCode.Types         Language.PureScript.Docs.Tags         Language.PureScript.Docs.Types         Language.PureScript.Docs.Utils.MonoidExtras-        Language.PureScript.Environment         Language.PureScript.Errors         Language.PureScript.Errors.JSON         Language.PureScript.Externs@@ -1016,8 +1486,6 @@         Language.PureScript.Interactive.Parser         Language.PureScript.Interactive.Printer         Language.PureScript.Interactive.Types-        Language.PureScript.Kinds-        Language.PureScript.Label         Language.PureScript.Linter         Language.PureScript.Linter.Exhaustive         Language.PureScript.Linter.Imports@@ -1027,14 +1495,11 @@         Language.PureScript.Make.Cache         Language.PureScript.Make.Monad         Language.PureScript.ModuleDependencies-        Language.PureScript.Names         Language.PureScript.Options         Language.PureScript.Pretty         Language.PureScript.Pretty.Common-        Language.PureScript.Pretty.Kinds         Language.PureScript.Pretty.Types         Language.PureScript.Pretty.Values-        Language.PureScript.PSString         Language.PureScript.Publish         Language.PureScript.Publish.BoxesHelpers         Language.PureScript.Publish.ErrorsWarnings@@ -1060,32 +1525,35 @@         Language.PureScript.Sugar.TypeClasses         Language.PureScript.Sugar.TypeClasses.Deriving         Language.PureScript.Sugar.TypeDeclarations-        Language.PureScript.Traversals         Language.PureScript.TypeChecker         Language.PureScript.TypeChecker.Entailment+        Language.PureScript.TypeChecker.Entailment.Coercible         Language.PureScript.TypeChecker.Kinds         Language.PureScript.TypeChecker.Monad+        Language.PureScript.TypeChecker.Roles         Language.PureScript.TypeChecker.Skolems         Language.PureScript.TypeChecker.Subsumption         Language.PureScript.TypeChecker.Synonyms         Language.PureScript.TypeChecker.Types         Language.PureScript.TypeChecker.TypeSearch         Language.PureScript.TypeChecker.Unify-        Language.PureScript.TypeClassDictionaries-        Language.PureScript.Types         System.IO.UTF8-    build-tools: happy ==1.19.9-    hs-source-dirs: src-    other-modules:-        Paths_purescript-    default-language: Haskell2010-    default-extensions: ConstraintKinds DataKinds DeriveFunctor-                        DeriveFoldable DeriveTraversable DeriveGeneric DerivingStrategies-                        EmptyDataDecls FlexibleContexts KindSignatures LambdaCase-                        MultiParamTypeClasses NoImplicitPrelude PatternGuards-                        PatternSynonyms RankNTypes RecordWildCards OverloadedStrings-                        ScopedTypeVariables TupleSections ViewPatterns-    ghc-options: -Wall -O2++    build-tools:        happy ==1.19.9+    hs-source-dirs:     src+    other-modules:      Paths_purescript+    default-language:   Haskell2010+    default-extensions:+        BangPatterns ConstraintKinds DataKinds DefaultSignatures+        DeriveFunctor DeriveFoldable DeriveTraversable DeriveGeneric+        DerivingStrategies EmptyDataDecls FlexibleContexts+        FlexibleInstances GeneralizedNewtypeDeriving KindSignatures+        LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude+        PatternGuards PatternSynonyms RankNTypes RecordWildCards+        OverloadedStrings ScopedTypeVariables TupleSections TypeFamilies+        ViewPatterns++    ghc-options:        -Wall -O2     build-depends:         Cabal >=2.2 && <3.0,         Glob ==0.9.*,@@ -1108,13 +1576,12 @@         data-ordlist >=0.4.7.0 && <0.5,         deepseq <1.5,         directory >=1.2.3 && <1.4,-        dlist <0.9,         edit-distance <0.3,         file-embed <0.1,         filepath <1.5,         fsnotify >=0.2.1 && <0.4,         haskeline >=0.7.0.0 && <0.8.0.0,-        language-javascript >=0.7.0.0 && <0.8,+        language-javascript ==0.7.0.0,         lifted-async >=0.10.0.3 && <0.10.1,         lifted-base ==0.2.3.*,         memory ==0.14.*,@@ -1127,9 +1594,10 @@         pattern-arrows >=0.0.2 && <0.1,         process >=1.2.0 && <1.7,         protolude >=0.1.6 && <0.2.4,+        purescript-ast <0.2,+        purescript-cst <0.2,         regex-tdfa <1.3,         safe >=0.3.9 && <0.4,-        scientific >=0.3.4.9 && <0.4,         semialign >=1 && <1.1,         semigroups >=0.16.2 && <0.19,         serialise <0.3,@@ -1149,9 +1617,9 @@         vector <0.13  executable purs-    main-is: Main.hs-    build-tools: happy ==1.19.9-    hs-source-dirs: app+    main-is:            Main.hs+    build-tools:        happy ==1.19.9+    hs-source-dirs:     app     other-modules:         Command.Bundle         Command.Compile@@ -1165,9 +1633,22 @@         Command.REPL         Paths_purescript         Version-    default-language: Haskell2010-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts-                 -with-rtsopts=-N++    default-language:   Haskell2010+    default-extensions:+        BangPatterns ConstraintKinds DataKinds DefaultSignatures+        DeriveFunctor DeriveFoldable DeriveTraversable DeriveGeneric+        DerivingStrategies EmptyDataDecls FlexibleContexts+        FlexibleInstances GeneralizedNewtypeDeriving KindSignatures+        LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude+        PatternGuards PatternSynonyms RankNTypes RecordWildCards+        OverloadedStrings ScopedTypeVariables TupleSections TypeFamilies+        ViewPatterns++    ghc-options:+        -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts+        -with-rtsopts=-N+     build-depends:         Cabal >=2.2 && <3.0,         Glob ==0.9.*,@@ -1191,14 +1672,13 @@         data-ordlist >=0.4.7.0 && <0.5,         deepseq <1.5,         directory >=1.2.3 && <1.4,-        dlist <0.9,         edit-distance <0.3,         file-embed <0.1,         filepath <1.5,         fsnotify >=0.2.1 && <0.4,         haskeline >=0.7.0.0 && <0.8.0.0,         http-types <0.13,-        language-javascript >=0.7.0.0 && <0.8,+        language-javascript ==0.7.0.0,         lifted-async >=0.10.0.3 && <0.10.1,         lifted-base ==0.2.3.*,         memory ==0.14.*,@@ -1214,9 +1694,10 @@         process >=1.2.0 && <1.7,         protolude >=0.1.6 && <0.2.4,         purescript -any,+        purescript-ast <0.2,+        purescript-cst <0.2,         regex-tdfa <1.3,         safe >=0.3.9 && <0.4,-        scientific >=0.3.4.9 && <0.4,         semialign >=1 && <1.1,         semigroups >=0.16.2 && <0.19,         serialise <0.3,@@ -1238,18 +1719,18 @@         wai-websockets ==3.*,         warp ==3.*,         websockets >=0.9 && <0.13-    +     if flag(release)         cpp-options: -DRELEASE+     else-        build-depends:-            gitrev >=1.2.0 && <1.4+        build-depends: gitrev >=1.2.0 && <1.4  test-suite tests-    type: exitcode-stdio-1.0-    main-is: Main.hs-    build-tools: happy ==1.19.9-    hs-source-dirs: tests+    type:               exitcode-stdio-1.0+    main-is:            Main.hs+    build-tools:        happy ==1.19.9+    hs-source-dirs:     tests     other-modules:         Language.PureScript.Ide.CompletionSpec         Language.PureScript.Ide.FilterSpec@@ -1265,7 +1746,6 @@         TestBundle         TestCompiler         TestCoreFn-        TestCst         TestDocs         TestGraph         TestHierarchy@@ -1280,9 +1760,19 @@         TestPscPublish         TestUtils         Paths_purescript-    default-language: Haskell2010-    default-extensions: NoImplicitPrelude LambdaCase OverloadedStrings-    ghc-options: -Wall++    default-language:   Haskell2010+    default-extensions:+        BangPatterns ConstraintKinds DataKinds DefaultSignatures+        DeriveFunctor DeriveFoldable DeriveTraversable DeriveGeneric+        DerivingStrategies EmptyDataDecls FlexibleContexts+        FlexibleInstances GeneralizedNewtypeDeriving KindSignatures+        LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude+        PatternGuards PatternSynonyms RankNTypes RecordWildCards+        OverloadedStrings ScopedTypeVariables TupleSections TypeFamilies+        ViewPatterns++    ghc-options:        -Wall     build-depends:         Cabal >=2.2 && <3.0,         Glob ==0.9.*,@@ -1306,7 +1796,6 @@         data-ordlist >=0.4.7.0 && <0.5,         deepseq <1.5,         directory >=1.2.3 && <1.4,-        dlist <0.9,         edit-distance <0.3,         file-embed <0.1,         filepath <1.5,@@ -1314,7 +1803,7 @@         haskeline >=0.7.0.0 && <0.8.0.0,         hspec <2.7,         hspec-discover <2.7,-        language-javascript >=0.7.0.0 && <0.8,+        language-javascript ==0.7.0.0,         lifted-async >=0.10.0.3 && <0.10.1,         lifted-base ==0.2.3.*,         memory ==0.14.*,@@ -1328,9 +1817,11 @@         process >=1.2.0 && <1.7,         protolude >=0.1.6 && <0.2.4,         purescript -any,+        purescript-ast <0.2,+        purescript-cst <0.2,+        regex-base <0.94,         regex-tdfa <1.3,         safe >=0.3.9 && <0.4,-        scientific >=0.3.4.9 && <0.4,         semialign >=1 && <1.1,         semigroups >=0.16.2 && <0.19,         serialise <0.3,
− src/Control/Monad/Supply.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Fresh variable supply----module Control.Monad.Supply where--import Prelude.Compat--import Control.Applicative-import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.Writer--import Data.Functor.Identity--newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }-  deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r, Alternative, MonadPlus)--runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)-runSupplyT n = flip runStateT n . unSupplyT--evalSupplyT :: (Functor m) => Integer -> SupplyT m a -> m a-evalSupplyT n = fmap fst . runSupplyT n--type Supply = SupplyT Identity--runSupply :: Integer -> Supply a -> (a, Integer)-runSupply n = runIdentity . runSupplyT n--evalSupply :: Integer -> Supply a -> a-evalSupply n = runIdentity . evalSupplyT n
− src/Control/Monad/Supply/Class.hs 
@@ -1,36 +0,0 @@--- |--- A class for monads supporting a supply of fresh names-----{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE TypeFamilies #-}--module Control.Monad.Supply.Class where--import Prelude.Compat--import Control.Monad.Supply-import Control.Monad.State-import Control.Monad.Writer-import Data.Text (Text, pack)--class Monad m => MonadSupply m where-  fresh :: m Integer-  peek :: m Integer-  default fresh :: (MonadTrans t, MonadSupply n, m ~ t n) => m Integer-  fresh = lift fresh-  default peek :: (MonadTrans t, MonadSupply n, m ~ t n) => m Integer-  peek = lift peek--instance Monad m => MonadSupply (SupplyT m) where-  fresh = SupplyT $ do-    n <- get-    put (n + 1)-    return n-  peek = SupplyT get--instance MonadSupply m => MonadSupply (StateT s m)-instance (Monoid w, MonadSupply m) => MonadSupply (WriterT w m)--freshName :: MonadSupply m => m Text-freshName = fmap (("$" <> ) . pack . show) fresh
src/Language/PureScript.hs view
@@ -18,7 +18,6 @@ import Language.PureScript.Errors as P hiding (indent) import Language.PureScript.Externs as P import Language.PureScript.Graph as P-import Language.PureScript.Kinds as P import Language.PureScript.Linter as P import Language.PureScript.Make as P import Language.PureScript.ModuleDependencies as P@@ -26,6 +25,7 @@ import Language.PureScript.Options as P import Language.PureScript.Pretty as P import Language.PureScript.Renamer as P+import Language.PureScript.Roles as P import Language.PureScript.Sugar as P import Language.PureScript.TypeChecker as P import Language.PureScript.Types as P
− src/Language/PureScript/AST.hs 
@@ -1,14 +0,0 @@--- |--- The initial PureScript AST----module Language.PureScript.AST (-    module AST-) where--import Language.PureScript.AST.Binders as AST-import Language.PureScript.AST.Declarations as AST-import Language.PureScript.AST.Exported as AST-import Language.PureScript.AST.Literals as AST-import Language.PureScript.AST.Operators as AST-import Language.PureScript.AST.SourcePos as AST-import Language.PureScript.AST.Traversals as AST
− src/Language/PureScript/AST/Binders.hs 
@@ -1,193 +0,0 @@--- |--- Case binders----module Language.PureScript.AST.Binders where--import Prelude.Compat--import Language.PureScript.AST.SourcePos-import Language.PureScript.AST.Literals-import Language.PureScript.Names-import Language.PureScript.Comments-import Language.PureScript.Types---- |--- Data type for binders----data Binder-  -- |-  -- Wildcard binder-  ---  = NullBinder-  -- |-  -- A binder which matches a literal-  ---  | LiteralBinder SourceSpan (Literal Binder)-  -- |-  -- A binder which binds an identifier-  ---  | VarBinder SourceSpan Ident-  -- |-  -- A binder which matches a data constructor-  ---  | ConstructorBinder SourceSpan (Qualified (ProperName 'ConstructorName)) [Binder]-  -- |-  -- A operator alias binder. During the rebracketing phase of desugaring,-  -- this data constructor will be removed.-  ---  | OpBinder SourceSpan (Qualified (OpName 'ValueOpName))-  -- |-  -- Binary operator application. During the rebracketing phase of desugaring,-  -- this data constructor will be removed.-  ---  | BinaryNoParensBinder Binder Binder Binder-  -- |-  -- Explicit parentheses. During the rebracketing phase of desugaring, this-  -- data constructor will be removed.-  ---  -- Note: although it seems this constructor is not used, it _is_ useful,-  -- since it prevents certain traversals from matching.-  ---  | ParensInBinder Binder-  -- |-  -- A binder which binds its input to an identifier-  ---  | NamedBinder SourceSpan Ident Binder-  -- |-  -- A binder with source position information-  ---  | PositionedBinder SourceSpan [Comment] Binder-  -- |-  -- A binder with a type annotation-  ---  | TypedBinder SourceType Binder-  deriving (Show)---- Manual Eq and Ord instances for `Binder` were added on 2018-03-05. Comparing--- the `SourceSpan` values embedded in some of the data constructors of `Binder`--- was expensive. This made exhaustiveness checking observably slow for code--- such as the `explode` function in `test/purs/passing/LargeSumTypes.purs`.--- Custom instances were written to skip comparing the `SourceSpan` values. Only--- the `Ord` instance was needed for the speed-up, but I did not want the `Eq`--- to have mismatched behavior.-instance Eq Binder where-  (==) NullBinder NullBinder = True-  (==) NullBinder _ = False--  (==) (LiteralBinder _ lb) (LiteralBinder _ lb') = (==) lb lb'-  (==) LiteralBinder{} _ = False--  (==) (VarBinder _ ident) (VarBinder _ ident') = (==) ident ident'-  (==) VarBinder{} _ = False--  (==) (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =-    (==) qpc qpc' && (==) bs bs'-  (==) ConstructorBinder{} _ = False--  (==) (OpBinder _ qov) (OpBinder _ qov') =-    (==) qov qov'-  (==) OpBinder{} _ = False--  (==) (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =-    (==) b1 b1' && (==) b2 b2' && (==) b3 b3'-  (==) BinaryNoParensBinder{} _ = False--  (==) (ParensInBinder b) (ParensInBinder b') =-    (==) b b'-  (==) ParensInBinder{} _ = False--  (==) (NamedBinder _ ident b) (NamedBinder _ ident' b') =-    (==) ident ident' && (==) b b'-  (==) NamedBinder{} _ = False--  (==) (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =-    (==) comments comments' && (==) b b'-  (==) PositionedBinder{} _ = False--  (==) (TypedBinder ty b) (TypedBinder ty' b') =-    (==) ty ty' && (==) b b'-  (==) TypedBinder{} _ = False--instance Ord Binder where-  compare NullBinder NullBinder = EQ-  compare NullBinder _ = LT--  compare (LiteralBinder _ lb) (LiteralBinder _ lb') = compare lb lb'-  compare LiteralBinder{} NullBinder = GT-  compare LiteralBinder{} _ = LT--  compare (VarBinder _ ident) (VarBinder _ ident') = compare ident ident'-  compare VarBinder{} NullBinder = GT-  compare VarBinder{} LiteralBinder{} = GT-  compare VarBinder{} _ = LT--  compare (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =-    compare qpc qpc' <> compare bs bs'-  compare ConstructorBinder{} NullBinder = GT-  compare ConstructorBinder{} LiteralBinder{} = GT-  compare ConstructorBinder{} VarBinder{} = GT-  compare ConstructorBinder{} _ = LT--  compare (OpBinder _ qov) (OpBinder _ qov') =-    compare qov qov'-  compare OpBinder{} NullBinder = GT-  compare OpBinder{} LiteralBinder{} = GT-  compare OpBinder{} VarBinder{} = GT-  compare OpBinder{} ConstructorBinder{} = GT-  compare OpBinder{} _ = LT--  compare (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =-    compare b1 b1' <> compare b2 b2' <> compare b3 b3'-  compare BinaryNoParensBinder{} ParensInBinder{} = LT-  compare BinaryNoParensBinder{} NamedBinder{} = LT-  compare BinaryNoParensBinder{} PositionedBinder{} = LT-  compare BinaryNoParensBinder{} TypedBinder{} = LT-  compare BinaryNoParensBinder{} _ = GT--  compare (ParensInBinder b) (ParensInBinder b') =-    compare b b'-  compare ParensInBinder{} NamedBinder{} = LT-  compare ParensInBinder{} PositionedBinder{} = LT-  compare ParensInBinder{} TypedBinder{} = LT-  compare ParensInBinder{} _ = GT--  compare (NamedBinder _ ident b) (NamedBinder _ ident' b') =-    compare ident ident' <> compare b b'-  compare NamedBinder{} PositionedBinder{} = LT-  compare NamedBinder{} TypedBinder{} = LT-  compare NamedBinder{} _ = GT--  compare (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =-    compare comments comments' <> compare b b'-  compare PositionedBinder{} TypedBinder{} = LT-  compare PositionedBinder{} _ = GT--  compare (TypedBinder ty b) (TypedBinder ty' b') =-    compare ty ty' <> compare b b'-  compare TypedBinder{} _ = GT---- |--- Collect all names introduced in binders in an expression----binderNames :: Binder -> [Ident]-binderNames = go []-  where-  go ns (LiteralBinder _ b) = lit ns b-  go ns (VarBinder _ name) = name : ns-  go ns (ConstructorBinder _ _ bs) = foldl go ns bs-  go ns (BinaryNoParensBinder b1 b2 b3) = foldl go ns [b1, b2, b3]-  go ns (ParensInBinder b) = go ns b-  go ns (NamedBinder _ name b) = go (name : ns) b-  go ns (PositionedBinder _ _ b) = go ns b-  go ns (TypedBinder _ b) = go ns b-  go ns _ = ns-  lit ns (ObjectLiteral bs) = foldl go ns (map snd bs)-  lit ns (ArrayLiteral bs) = foldl go ns bs-  lit ns _ = ns--isIrrefutable :: Binder -> Bool-isIrrefutable NullBinder = True-isIrrefutable (VarBinder _ _) = True-isIrrefutable (PositionedBinder _ _ b) = isIrrefutable b-isIrrefutable (TypedBinder _ b) = isIrrefutable b-isIrrefutable _ = False
− src/Language/PureScript/AST/Declarations.hs 
@@ -1,937 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveAnyClass #-}---- |--- Data types for modules and declarations----module Language.PureScript.AST.Declarations where--import Prelude.Compat--import Codec.Serialise (Serialise)-import Control.DeepSeq (NFData)-import Control.Monad.Identity--import Data.Aeson.TH-import qualified Data.Map as M-import Data.Set (Set)-import Data.Text (Text)-import qualified Data.List.NonEmpty as NEL-import GHC.Generics (Generic)--import Language.PureScript.AST.Binders-import Language.PureScript.AST.Literals-import Language.PureScript.AST.Operators-import Language.PureScript.AST.SourcePos-import Language.PureScript.Types-import Language.PureScript.PSString (PSString)-import Language.PureScript.Label (Label)-import Language.PureScript.Names-import Language.PureScript.Kinds-import Language.PureScript.TypeClassDictionaries-import Language.PureScript.Comments-import Language.PureScript.Environment-import qualified Language.PureScript.Bundle as Bundle-import qualified Language.PureScript.Constants as C-import qualified Language.PureScript.CST.Errors as CST--import qualified Text.Parsec as P---- | A map of locally-bound names in scope.-type Context = [(Ident, SourceType)]---- | Holds the data necessary to do type directed search for typed holes-data TypeSearch-  = TSBefore Environment-  -- ^ An Environment captured for later consumption by type directed search-  | TSAfter-    { tsAfterIdentifiers :: [(Qualified Text, SourceType)]-    -- ^ The identifiers that fully satisfy the subsumption check-    , tsAfterRecordFields :: Maybe [(Label, SourceType)]-    -- ^ Record fields that are available on the first argument to the typed-    -- hole-    }-  -- ^ Results of applying type directed search to the previously captured-  -- Environment-  deriving Show--onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch-onTypeSearchTypes f = runIdentity . onTypeSearchTypesM (Identity . f)--onTypeSearchTypesM :: (Applicative m) => (SourceType -> m SourceType) -> TypeSearch -> m TypeSearch-onTypeSearchTypesM f (TSAfter i r) = TSAfter <$> traverse (traverse f) i <*> traverse (traverse (traverse f)) r-onTypeSearchTypesM _ (TSBefore env) = pure (TSBefore env)---- | A type of error messages-data SimpleErrorMessage-  = ModuleNotFound ModuleName-  | ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)-  | ErrorParsingModule P.ParseError-  | ErrorParsingCSTModule CST.ParserError-  | MissingFFIModule ModuleName-  | UnnecessaryFFIModule ModuleName FilePath-  | MissingFFIImplementations ModuleName [Ident]-  | UnusedFFIImplementations ModuleName [Ident]-  | InvalidFFIIdentifier ModuleName Text-  | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred-  | InfiniteType SourceType-  | InfiniteKind SourceKind-  | MultipleValueOpFixities (OpName 'ValueOpName)-  | MultipleTypeOpFixities (OpName 'TypeOpName)-  | OrphanTypeDeclaration Ident-  | RedefinedIdent Ident-  | OverlappingNamesInLet-  | UnknownName (Qualified Name)-  | UnknownImport ModuleName Name-  | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)-  | UnknownExport Name-  | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)-  | ScopeConflict Name [ModuleName]-  | ScopeShadowing Name (Maybe ModuleName) [ModuleName]-  | DeclConflict Name Name-  | ExportConflict (Qualified Name) (Qualified Name)-  | DuplicateModule ModuleName-  | DuplicateTypeClass (ProperName 'ClassName) SourceSpan-  | DuplicateInstance Ident SourceSpan-  | DuplicateTypeArgument Text-  | InvalidDoBind-  | InvalidDoLet-  | CycleInDeclaration Ident-  | CycleInTypeSynonym (Maybe (ProperName 'TypeName))-  | CycleInTypeClassDeclaration [Qualified (ProperName 'ClassName)]-  | CycleInModules [ModuleName]-  | NameIsUndefined Ident-  | UndefinedTypeVariable (ProperName 'TypeName)-  | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))-  | EscapedSkolem Text (Maybe SourceSpan) SourceType-  | TypesDoNotUnify SourceType SourceType-  | KindsDoNotUnify SourceKind SourceKind-  | ConstrainedTypeUnified SourceType SourceType-  | OverlappingInstances (Qualified (ProperName 'ClassName)) [SourceType] [Qualified Ident]-  | NoInstanceFound SourceConstraint-  | AmbiguousTypeVariables SourceType [Int]-  | UnknownClass (Qualified (ProperName 'ClassName))-  | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [SourceType]-  | CannotDerive (Qualified (ProperName 'ClassName)) [SourceType]-  | InvalidDerivedInstance (Qualified (ProperName 'ClassName)) [SourceType] Int-  | ExpectedTypeConstructor (Qualified (ProperName 'ClassName)) [SourceType] SourceType-  | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [SourceType]-  | MissingNewtypeSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]-  | UnverifiableSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]-  | CannotFindDerivingType (ProperName 'TypeName)-  | DuplicateLabel Label (Maybe Expr)-  | DuplicateValueDeclaration Ident-  | ArgListLengthsDiffer Ident-  | OverlappingArgNames (Maybe Ident)-  | MissingClassMember (NEL.NonEmpty (Ident, SourceType))-  | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))-  | ExpectedType SourceType SourceKind-  -- | constructor name, expected argument count, actual argument count-  | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName)) Int Int-  | ExprDoesNotHaveType Expr SourceType-  | PropertyIsMissing Label-  | AdditionalProperty Label-  | TypeSynonymInstance-  | OrphanInstance Ident (Qualified (ProperName 'ClassName)) (Set ModuleName) [SourceType]-  | InvalidNewtype (ProperName 'TypeName)-  | InvalidInstanceHead SourceType-  | TransitiveExportError DeclarationRef [DeclarationRef]-  | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)-  | ShadowedName Ident-  | ShadowedTypeVar Text-  | UnusedTypeVar Text-  | WildcardInferredType SourceType Context-  | HoleInferredType Text SourceType Context (Maybe TypeSearch)-  | MissingTypeDeclaration Ident SourceType-  | OverlappingPattern [[Binder]] Bool-  | IncompleteExhaustivityCheck-  | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)-  | ImportHidingModule ModuleName-  | UnusedImport ModuleName (Maybe ModuleName)-  | UnusedExplicitImport ModuleName [Name] (Maybe ModuleName) [DeclarationRef]-  | UnusedDctorImport ModuleName (ProperName 'TypeName) (Maybe ModuleName) [DeclarationRef]-  | UnusedDctorExplicitImport ModuleName (ProperName 'TypeName) [ProperName 'ConstructorName] (Maybe ModuleName) [DeclarationRef]-  | DuplicateSelectiveImport ModuleName-  | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)-  | DuplicateImportRef Name-  | DuplicateExportRef Name-  | IntOutOfRange Integer Text Integer Integer-  | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]-  | ImplicitQualifiedImportReExport ModuleName ModuleName [DeclarationRef]-  | ImplicitImport ModuleName [DeclarationRef]-  | HidingImport ModuleName [DeclarationRef]-  | CaseBinderLengthDiffers Int [Binder]-  | IncorrectAnonymousArgument-  | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)-  | CannotGeneralizeRecursiveFunction Ident SourceType-  | CannotDeriveNewtypeForData (ProperName 'TypeName)-  | ExpectedWildcard (ProperName 'TypeName)-  | CannotUseBindWithDo Ident-  -- | instance name, type class, expected argument count, actual argument count-  | ClassInstanceArityMismatch Ident (Qualified (ProperName 'ClassName)) Int Int-  -- | a user-defined warning raised by using the Warn type class-  | UserDefinedWarning SourceType-  -- | a declaration couldn't be used because it contained free variables-  | UnusableDeclaration Ident [[Text]]-  | CannotDefinePrimModules ModuleName-  | MixedAssociativityError (NEL.NonEmpty (Qualified (OpName 'AnyOpName), Associativity))-  | NonAssociativeError (NEL.NonEmpty (Qualified (OpName 'AnyOpName)))-  deriving (Show)---- | Error message hints, providing more detailed information about failure.-data ErrorMessageHint-  = ErrorUnifyingTypes SourceType SourceType-  | ErrorInExpression Expr-  | ErrorInModule ModuleName-  | ErrorInInstance (Qualified (ProperName 'ClassName)) [SourceType]-  | ErrorInSubsumption SourceType SourceType-  | ErrorCheckingAccessor Expr PSString-  | ErrorCheckingType Expr SourceType-  | ErrorCheckingKind SourceType-  | ErrorCheckingGuard-  | ErrorInferringType Expr-  | ErrorInApplication Expr SourceType Expr-  | ErrorInDataConstructor (ProperName 'ConstructorName)-  | ErrorInTypeConstructor (ProperName 'TypeName)-  | ErrorInBindingGroup (NEL.NonEmpty Ident)-  | ErrorInDataBindingGroup [ProperName 'TypeName]-  | ErrorInTypeSynonym (ProperName 'TypeName)-  | ErrorInValueDeclaration Ident-  | ErrorInTypeDeclaration Ident-  | ErrorInTypeClassDeclaration (ProperName 'ClassName)-  | ErrorInForeignImport Ident-  | ErrorSolvingConstraint SourceConstraint-  | PositionedError (NEL.NonEmpty SourceSpan)-  deriving (Show)---- | Categories of hints-data HintCategory-  = ExprHint-  | KindHint-  | CheckHint-  | PositionHint-  | SolverHint-  | OtherHint-  deriving (Show, Eq)--data ErrorMessage = ErrorMessage-  [ErrorMessageHint]-  SimpleErrorMessage-  deriving (Show)---- |--- A module declaration, consisting of comments about the module, a module name,--- a list of declarations, and a list of the declarations that are--- explicitly exported. If the export list is Nothing, everything is exported.----data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])-  deriving (Show)---- | Return a module's name.-getModuleName :: Module -> ModuleName-getModuleName (Module _ _ name _ _) = name---- | Return a module's source span.-getModuleSourceSpan :: Module -> SourceSpan-getModuleSourceSpan (Module ss _ _ _ _) = ss---- | Return a module's declarations.-getModuleDeclarations :: Module -> [Declaration]-getModuleDeclarations (Module _ _ _ declarations _) = declarations---- |--- Add an import declaration for a module if it does not already explicitly import it.------ Will not import an unqualified module if that module has already been imported qualified.--- (See #2197)----addDefaultImport :: Qualified ModuleName -> Module -> Module-addDefaultImport (Qualified toImportAs toImport) m@(Module ss coms mn decls exps) =-  if isExistingImport `any` decls || mn == toImport then m-  else Module ss coms mn (ImportDeclaration (ss, []) toImport Implicit toImportAs : decls) exps-  where-  isExistingImport (ImportDeclaration _ mn' _ as')-    | mn' == toImport =-        case toImportAs of-          Nothing -> True-          _ -> as' == toImportAs-  isExistingImport _ = False---- | Adds import declarations to a module for an implicit Prim import and Prim--- | qualified as Prim, as necessary.-importPrim :: Module -> Module-importPrim =-  let-    primModName = C.Prim-  in-    addDefaultImport (Qualified (Just primModName) primModName)-      . addDefaultImport (Qualified Nothing primModName)---- |--- An item in a list of explicit imports or exports----data DeclarationRef-  -- |-  -- A type constructor with data constructors-  ---  = TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])-  -- |-  -- A type operator-  ---  | TypeOpRef SourceSpan (OpName 'TypeOpName)-  -- |-  -- A value-  ---  | ValueRef SourceSpan Ident-  -- |-  -- A value-level operator-  ---  | ValueOpRef SourceSpan (OpName 'ValueOpName)-  -- |-  -- A type class-  ---  | TypeClassRef SourceSpan (ProperName 'ClassName)-  -- |-  -- A type class instance, created during typeclass desugaring (name, class name, instance types)-  ---  | TypeInstanceRef SourceSpan Ident-  -- |-  -- A module, in its entirety-  ---  | ModuleRef SourceSpan ModuleName-  -- |-  -- A named kind-  ---  | KindRef SourceSpan (ProperName 'KindName)-  -- |-  -- A value re-exported from another module. These will be inserted during-  -- elaboration in name desugaring.-  ---  | ReExportRef SourceSpan ExportSource DeclarationRef-  deriving (Show, Generic, NFData, Serialise)--instance Eq DeclarationRef where-  (TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors'-  (TypeOpRef _ name) == (TypeOpRef _ name') = name == name'-  (ValueRef _ name) == (ValueRef _ name') = name == name'-  (ValueOpRef _ name) == (ValueOpRef _ name') = name == name'-  (TypeClassRef _ name) == (TypeClassRef _ name') = name == name'-  (TypeInstanceRef _ name) == (TypeInstanceRef _ name') = name == name'-  (ModuleRef _ name) == (ModuleRef _ name') = name == name'-  (KindRef _ name) == (KindRef _ name') = name == name'-  (ReExportRef _ mn ref) == (ReExportRef _ mn' ref') = mn == mn' && ref == ref'-  _ == _ = False--data ExportSource =-  ExportSource-  { exportSourceImportedFrom :: Maybe ModuleName-  , exportSourceDefinedIn :: ModuleName-  }-  deriving (Eq, Ord, Show, Generic, NFData, Serialise)---- enable sorting lists of explicitly imported refs when suggesting imports in linting, IDE, etc.--- not an Ord because this implementation is not consistent with its Eq instance.--- think of it as a notion of contextual, not inherent, ordering.-compDecRef :: DeclarationRef -> DeclarationRef -> Ordering-compDecRef (TypeRef _ name _) (TypeRef _ name' _) = compare name name'-compDecRef (TypeOpRef _ name) (TypeOpRef _ name') = compare name name'-compDecRef (ValueRef _ ident) (ValueRef _ ident') = compare ident ident'-compDecRef (ValueOpRef _ name) (ValueOpRef _ name') = compare name name'-compDecRef (TypeClassRef _ name) (TypeClassRef _ name') = compare name name'-compDecRef (TypeInstanceRef _ ident) (TypeInstanceRef _ ident') = compare ident ident'-compDecRef (ModuleRef _ name) (ModuleRef _ name') = compare name name'-compDecRef (KindRef _ name) (KindRef _ name') = compare name name'-compDecRef (ReExportRef _ name _) (ReExportRef _ name' _) = compare name name'-compDecRef ref ref' = compare-  (orderOf ref) (orderOf ref')-    where-      orderOf :: DeclarationRef -> Int-      orderOf TypeClassRef{} = 0-      orderOf TypeOpRef{} = 1-      orderOf TypeRef{} = 2-      orderOf ValueRef{} = 3-      orderOf ValueOpRef{} = 4-      orderOf KindRef{} = 5-      orderOf _ = 6--declRefSourceSpan :: DeclarationRef -> SourceSpan-declRefSourceSpan (TypeRef ss _ _) = ss-declRefSourceSpan (TypeOpRef ss _) = ss-declRefSourceSpan (ValueRef ss _) = ss-declRefSourceSpan (ValueOpRef ss _) = ss-declRefSourceSpan (TypeClassRef ss _) = ss-declRefSourceSpan (TypeInstanceRef ss _) = ss-declRefSourceSpan (ModuleRef ss _) = ss-declRefSourceSpan (KindRef ss _) = ss-declRefSourceSpan (ReExportRef ss _ _) = ss--declRefName :: DeclarationRef -> Name-declRefName (TypeRef _ n _) = TyName n-declRefName (TypeOpRef _ n) = TyOpName n-declRefName (ValueRef _ n) = IdentName n-declRefName (ValueOpRef _ n) = ValOpName n-declRefName (TypeClassRef _ n) = TyClassName n-declRefName (TypeInstanceRef _ n) = IdentName n-declRefName (ModuleRef _ n) = ModName n-declRefName (KindRef _ n) = KiName n-declRefName (ReExportRef _ _ ref) = declRefName ref--getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])-getTypeRef (TypeRef _ name dctors) = Just (name, dctors)-getTypeRef _ = Nothing--getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)-getTypeOpRef (TypeOpRef _ op) = Just op-getTypeOpRef _ = Nothing--getValueRef :: DeclarationRef -> Maybe Ident-getValueRef (ValueRef _ name) = Just name-getValueRef _ = Nothing--getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)-getValueOpRef (ValueOpRef _ op) = Just op-getValueOpRef _ = Nothing--getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)-getTypeClassRef (TypeClassRef _ name) = Just name-getTypeClassRef _ = Nothing--getKindRef :: DeclarationRef -> Maybe (ProperName 'KindName)-getKindRef (KindRef _ name) = Just name-getKindRef _ = Nothing--isModuleRef :: DeclarationRef -> Bool-isModuleRef ModuleRef{} = True-isModuleRef _ = False---- |--- The data type which specifies type of import declaration----data ImportDeclarationType-  -- |-  -- An import with no explicit list: `import M`.-  ---  = Implicit-  -- |-  -- An import with an explicit list of references to import: `import M (foo)`-  ---  | Explicit [DeclarationRef]-  -- |-  -- An import with a list of references to hide: `import M hiding (foo)`-  ---  | Hiding [DeclarationRef]-  deriving (Eq, Show, Generic, Serialise)--isImplicit :: ImportDeclarationType -> Bool-isImplicit Implicit = True-isImplicit _ = False--isExplicit :: ImportDeclarationType -> Bool-isExplicit (Explicit _) = True-isExplicit _ = False---- | A type declaration assigns a type to an identifier, eg:------ @identity :: forall a. a -> a@------ In this example @identity@ is the identifier and @forall a. a -> a@ the type.-data TypeDeclarationData = TypeDeclarationData-  { tydeclSourceAnn :: !SourceAnn-  , tydeclIdent :: !Ident-  , tydeclType :: !SourceType-  } deriving (Show, Eq)--overTypeDeclaration :: (TypeDeclarationData -> TypeDeclarationData) -> Declaration -> Declaration-overTypeDeclaration f d = maybe d (TypeDeclaration . f) (getTypeDeclaration d)--getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData-getTypeDeclaration (TypeDeclaration d) = Just d-getTypeDeclaration _ = Nothing--unwrapTypeDeclaration :: TypeDeclarationData -> (Ident, SourceType)-unwrapTypeDeclaration td = (tydeclIdent td, tydeclType td)---- | A value declaration assigns a name and potential binders, to an expression (or multiple guarded expressions).------ @double x = x + x@------ In this example @double@ is the identifier, @x@ is a binder and @x + x@ is the expression.-data ValueDeclarationData a = ValueDeclarationData-  { valdeclSourceAnn :: !SourceAnn-  , valdeclIdent :: !Ident-  -- ^ The declared value's name-  , valdeclName :: !NameKind-  -- ^ Whether or not this value is exported/visible-  , valdeclBinders :: ![Binder]-  , valdeclExpression :: !a-  } deriving (Show, Functor, Foldable, Traversable)--overValueDeclaration :: (ValueDeclarationData [GuardedExpr] -> ValueDeclarationData [GuardedExpr]) -> Declaration -> Declaration-overValueDeclaration f d = maybe d (ValueDeclaration . f) (getValueDeclaration d)--getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr])-getValueDeclaration (ValueDeclaration d) = Just d-getValueDeclaration _ = Nothing--pattern ValueDecl :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration-pattern ValueDecl sann ident name binders expr-  = ValueDeclaration (ValueDeclarationData sann ident name binders expr)--data DataConstructorDeclaration = DataConstructorDeclaration-  { dataCtorAnn :: !SourceAnn-  , dataCtorName :: !(ProperName 'ConstructorName)-  , dataCtorFields :: ![(Ident, SourceType)]-  } deriving (Show, Eq)--traverseDataCtorFields :: Monad m => ([(Ident, SourceType)] -> m [(Ident, SourceType)]) -> DataConstructorDeclaration -> m DataConstructorDeclaration-traverseDataCtorFields f DataConstructorDeclaration{..} = DataConstructorDeclaration dataCtorAnn dataCtorName <$> f dataCtorFields---- |--- The data type of declarations----data Declaration-  -- |-  -- A data type declaration (data or newtype, name, arguments, data constructors)-  ---  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceKind)] [DataConstructorDeclaration]-  -- |-  -- A minimal mutually recursive set of data type declarations-  ---  | DataBindingGroupDeclaration (NEL.NonEmpty Declaration)-  -- |-  -- A type synonym declaration (name, arguments, type)-  ---  | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text, Maybe SourceKind)] SourceType-  -- |-  -- A type declaration for a value (name, ty)-  ---  | TypeDeclaration {-# UNPACK #-} !TypeDeclarationData-  -- |-  -- A value declaration (name, top-level binders, optional guard, value)-  ---  | ValueDeclaration {-# UNPACK #-} !(ValueDeclarationData [GuardedExpr])-  -- |-  -- A declaration paired with pattern matching in let-in expression (binder, optional guard, value)-  | BoundValueDeclaration SourceAnn Binder Expr-  -- |-  -- A minimal mutually recursive set of value declarations-  ---  | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr))-  -- |-  -- A foreign import declaration (name, type)-  ---  | ExternDeclaration SourceAnn Ident SourceType-  -- |-  -- A data type foreign import (name, kind)-  ---  | ExternDataDeclaration SourceAnn (ProperName 'TypeName) SourceKind-  -- |-  -- A foreign kind import (name)-  ---  | ExternKindDeclaration SourceAnn (ProperName 'KindName)-  -- |-  -- A fixity declaration-  ---  | FixityDeclaration SourceAnn (Either ValueFixity TypeFixity)-  -- |-  -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)-  ---  | ImportDeclaration SourceAnn ModuleName ImportDeclarationType (Maybe ModuleName)-  -- |-  -- A type class declaration (name, argument, implies, member declarations)-  ---  | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, Maybe SourceKind)] [SourceConstraint] [FunctionalDependency] [Declaration]-  -- |-  -- A type instance declaration (instance chain, chain index, name,-  -- dependencies, class name, instance types, member declarations)-  ---  | TypeInstanceDeclaration SourceAnn [Ident] Integer Ident [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody-  deriving (Show)--data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)-  deriving (Eq, Ord, Show)--data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)-  deriving (Eq, Ord, Show)--pattern ValueFixityDeclaration :: SourceAnn -> Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration-pattern ValueFixityDeclaration sa fixity name op = FixityDeclaration sa (Left (ValueFixity fixity name op))--pattern TypeFixityDeclaration :: SourceAnn -> Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration-pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op))---- | The members of a type class instance declaration-data TypeInstanceBody-  = DerivedInstance-  -- ^ This is a derived instance-  | NewtypeInstance-  -- ^ This is an instance derived from a newtype-  | NewtypeInstanceWithDictionary Expr-  -- ^ This is an instance derived from a newtype, desugared to include a-  -- dictionary for the type under the newtype.-  | ExplicitInstance [Declaration]-  -- ^ This is a regular (explicit) instance-  deriving (Show)--mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody-mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)---- | A traversal for TypeInstanceBody-traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody-traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds-traverseTypeInstanceBody _ other = pure other--declSourceAnn :: Declaration -> SourceAnn-declSourceAnn (DataDeclaration sa _ _ _ _) = sa-declSourceAnn (DataBindingGroupDeclaration ds) = declSourceAnn (NEL.head ds)-declSourceAnn (TypeSynonymDeclaration sa _ _ _) = sa-declSourceAnn (TypeDeclaration td) = tydeclSourceAnn td-declSourceAnn (ValueDeclaration vd) = valdeclSourceAnn vd-declSourceAnn (BoundValueDeclaration sa _ _) = sa-declSourceAnn (BindingGroupDeclaration ds) = let ((sa, _), _, _) = NEL.head ds in sa-declSourceAnn (ExternDeclaration sa _ _) = sa-declSourceAnn (ExternDataDeclaration sa _ _) = sa-declSourceAnn (ExternKindDeclaration sa _) = sa-declSourceAnn (FixityDeclaration sa _) = sa-declSourceAnn (ImportDeclaration sa _ _ _) = sa-declSourceAnn (TypeClassDeclaration sa _ _ _ _ _) = sa-declSourceAnn (TypeInstanceDeclaration sa _ _ _ _ _ _ _) = sa--declSourceSpan :: Declaration -> SourceSpan-declSourceSpan = fst . declSourceAnn--declName :: Declaration -> Maybe Name-declName (DataDeclaration _ _ n _ _) = Just (TyName n)-declName (TypeSynonymDeclaration _ n _ _) = Just (TyName n)-declName (ValueDeclaration vd) = Just (IdentName (valdeclIdent vd))-declName (ExternDeclaration _ n _) = Just (IdentName n)-declName (ExternDataDeclaration _ n _) = Just (TyName n)-declName (ExternKindDeclaration _ n) = Just (KiName n)-declName (FixityDeclaration _ (Left (ValueFixity _ _ n))) = Just (ValOpName n)-declName (FixityDeclaration _ (Right (TypeFixity _ _ n))) = Just (TyOpName n)-declName (TypeClassDeclaration _ n _ _ _ _) = Just (TyClassName n)-declName (TypeInstanceDeclaration _ _ _ n _ _ _ _) = Just (IdentName n)-declName ImportDeclaration{} = Nothing-declName BindingGroupDeclaration{} = Nothing-declName DataBindingGroupDeclaration{} = Nothing-declName BoundValueDeclaration{} = Nothing-declName TypeDeclaration{} = Nothing---- |--- Test if a declaration is a value declaration----isValueDecl :: Declaration -> Bool-isValueDecl ValueDeclaration{} = True-isValueDecl _ = False---- |--- Test if a declaration is a data type or type synonym declaration----isDataDecl :: Declaration -> Bool-isDataDecl DataDeclaration{} = True-isDataDecl TypeSynonymDeclaration{} = True-isDataDecl _ = False---- |--- Test if a declaration is a module import----isImportDecl :: Declaration -> Bool-isImportDecl ImportDeclaration{} = True-isImportDecl _ = False---- |--- Test if a declaration is a data type foreign import----isExternDataDecl :: Declaration -> Bool-isExternDataDecl ExternDataDeclaration{} = True-isExternDataDecl _ = False---- |--- Test if a declaration is a foreign kind import----isExternKindDecl :: Declaration -> Bool-isExternKindDecl ExternKindDeclaration{} = True-isExternKindDecl _ = False---- |--- Test if a declaration is a fixity declaration----isFixityDecl :: Declaration -> Bool-isFixityDecl FixityDeclaration{} = True-isFixityDecl _ = False--getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)-getFixityDecl (FixityDeclaration _ fixity) = Just fixity-getFixityDecl _ = Nothing---- |--- Test if a declaration is a foreign import----isExternDecl :: Declaration -> Bool-isExternDecl ExternDeclaration{} = True-isExternDecl _ = False---- |--- Test if a declaration is a type class instance declaration----isTypeClassInstanceDeclaration :: Declaration -> Bool-isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True-isTypeClassInstanceDeclaration _ = False---- |--- Test if a declaration is a type class declaration----isTypeClassDeclaration :: Declaration -> Bool-isTypeClassDeclaration TypeClassDeclaration{} = True-isTypeClassDeclaration _ = False---- |--- Recursively flatten data binding groups in the list of declarations-flattenDecls :: [Declaration] -> [Declaration]-flattenDecls = concatMap flattenOne-    where flattenOne :: Declaration -> [Declaration]-          flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls-          flattenOne d = [d]---- |--- A guard is just a boolean-valued expression that appears alongside a set of binders----data Guard = ConditionGuard Expr-           | PatternGuard Binder Expr-           deriving (Show)---- |--- The right hand side of a binder in value declarations--- and case expressions.-data GuardedExpr = GuardedExpr [Guard] Expr-                 deriving (Show)--pattern MkUnguarded :: Expr -> GuardedExpr-pattern MkUnguarded e = GuardedExpr [] e---- |--- Data type for expressions and terms----data Expr-  -- |-  -- A literal value-  ---  = Literal SourceSpan (Literal Expr)-  -- |-  -- A prefix -, will be desugared-  ---  | UnaryMinus SourceSpan Expr-  -- |-  -- Binary operator application. During the rebracketing phase of desugaring, this data constructor-  -- will be removed.-  ---  | BinaryNoParens Expr Expr Expr-  -- |-  -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor-  -- will be removed.-  ---  -- Note: although it seems this constructor is not used, it _is_ useful, since it prevents-  -- certain traversals from matching.-  ---  | Parens Expr-  -- |-  -- An record property accessor expression (e.g. `obj.x` or `_.x`).-  -- Anonymous arguments will be removed during desugaring and expanded-  -- into a lambda that reads a property from a record.-  ---  | Accessor PSString Expr-  -- |-  -- Partial record update-  ---  | ObjectUpdate Expr [(PSString, Expr)]-  -- |-  -- Object updates with nested support: `x { foo { bar = e } }`-  -- Replaced during desugaring into a `Let` and nested `ObjectUpdate`s-  ---  | ObjectUpdateNested Expr (PathTree Expr)-  -- |-  -- Function introduction-  ---  | Abs Binder Expr-  -- |-  -- Function application-  ---  | App Expr Expr-  -- |-  -- Hint that an expression is unused.-  -- This is used to ignore type class dictionaries that are necessarily empty.-  -- The inner expression lets us solve subgoals before eliminating the whole expression.-  -- The code gen will render this as `undefined`, regardless of what the inner expression is.-  | Unused Expr-  -- |-  -- Variable-  ---  | Var SourceSpan (Qualified Ident)-  -- |-  -- An operator. This will be desugared into a function during the "operators"-  -- phase of desugaring.-  ---  | Op SourceSpan (Qualified (OpName 'ValueOpName))-  -- |-  -- Conditional (if-then-else expression)-  ---  | IfThenElse Expr Expr Expr-  -- |-  -- A data constructor-  ---  | Constructor SourceSpan (Qualified (ProperName 'ConstructorName))-  -- |-  -- A case expression. During the case expansion phase of desugaring, top-level binders will get-  -- desugared into case expressions, hence the need for guards and multiple binders per branch here.-  ---  | Case [Expr] [CaseAlternative]-  -- |-  -- A value with a type annotation-  ---  | TypedValue Bool Expr SourceType-  -- |-  -- A let binding-  ---  | Let WhereProvenance [Declaration] Expr-  -- |-  -- A do-notation block-  ---  | Do (Maybe ModuleName) [DoNotationElement]-  -- |-  -- An ado-notation block-  ---  | Ado (Maybe ModuleName) [DoNotationElement] Expr-  -- |-  -- An application of a typeclass dictionary constructor. The value should be-  -- an ObjectLiteral.-  ---  | TypeClassDictionaryConstructorApp (Qualified (ProperName 'ClassName)) Expr-  -- |-  -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these-  -- placeholders will be replaced with actual expressions representing type classes dictionaries which-  -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look-  -- at superclass implementations when searching for a dictionary, the type class name and-  -- instance type, and the type class dictionaries in scope.-  ---  | TypeClassDictionary SourceConstraint-                        (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict))))-                        [ErrorMessageHint]-  -- |-  -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.-  ---  | TypeClassDictionaryAccessor (Qualified (ProperName 'ClassName)) Ident-  -- |-  -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking-  ---  | DeferredDictionary (Qualified (ProperName 'ClassName)) [SourceType]-  -- |-  -- A placeholder for an anonymous function argument-  ---  | AnonymousArgument-  -- |-  -- A typed hole that will be turned into a hint/error during typechecking-  ---  | Hole Text-  -- |-  -- A value with source position information-  ---  | PositionedValue SourceSpan [Comment] Expr-  deriving (Show)---- |--- Metadata that tells where a let binding originated----data WhereProvenance-  -- |-  -- The let binding was originally a where clause-  ---  = FromWhere-  -- |-  -- The let binding was always a let binding-  ---  | FromLet-  deriving (Show)---- |--- An alternative in a case statement----data CaseAlternative = CaseAlternative-  { -- |-    -- A collection of binders with which to match the inputs-    ---    caseAlternativeBinders :: [Binder]-    -- |-    -- The result expression or a collect of guarded expressions-    ---  , caseAlternativeResult :: [GuardedExpr]-  } deriving (Show)---- |--- A statement in a do-notation block----data DoNotationElement-  -- |-  -- A monadic value without a binder-  ---  = DoNotationValue Expr-  -- |-  -- A monadic value with a binder-  ---  | DoNotationBind Binder Expr-  -- |-  -- A let statement, i.e. a pure value with a binder-  ---  | DoNotationLet [Declaration]-  -- |-  -- A do notation element with source position information-  ---  | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement-  deriving (Show)----- For a record update such as:------  x { foo = 0---    , bar { baz = 1---          , qux = 2 } }------ We represent the updates as the `PathTree`:------  [ ("foo", Leaf 3)---  , ("bar", Branch [ ("baz", Leaf 1)---                   , ("qux", Leaf 2) ]) ]------ Which we then convert to an expression representing the following:------   let x' = x---   in x' { foo = 0---         , bar = x'.bar { baz = 1---                        , qux = 2 } }------ The `let` here is required to prevent re-evaluating the object expression `x`.--- However we don't generate this when using an anonymous argument for the object.-----newtype PathTree t = PathTree (AssocList PSString (PathNode t))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)--data PathNode t = Leaf t | Branch (PathTree t)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)--newtype AssocList k t = AssocList { runAssocList :: [(k, t)] }-  deriving (Show, Eq, Ord, Foldable, Functor, Traversable)--$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExportSource)--isTrueExpr :: Expr -> Bool-isTrueExpr (Literal _ (BooleanLiteral True)) = True-isTrueExpr (Var _ (Qualified (Just (ModuleName "Prelude")) (Ident "otherwise"))) = True-isTrueExpr (Var _ (Qualified (Just (ModuleName "Data.Boolean")) (Ident "otherwise"))) = True-isTrueExpr (TypedValue _ e _) = isTrueExpr e-isTrueExpr (PositionedValue _ _ e) = isTrueExpr e-isTrueExpr _ = False
− src/Language/PureScript/AST/Exported.hs 
@@ -1,156 +0,0 @@-module Language.PureScript.AST.Exported-  ( exportedDeclarations-  , isExported-  ) where--import Prelude.Compat-import Protolude (sortBy, on)--import Control.Category ((>>>))--import Data.Maybe (mapMaybe)-import qualified Data.Map as M--import Language.PureScript.AST.Declarations-import Language.PureScript.Types-import Language.PureScript.Names---- |--- Return a list of all declarations which are exported from a module.--- This function descends into data declarations to filter out unexported--- data constructors, and also filters out type instance declarations if--- they refer to classes or types which are not themselves exported.------ Note that this function assumes that the module has already had its imports--- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will--- produce incorrect results if this is not the case - for example, type class--- instances will be incorrectly removed in some cases.------ The returned declarations are in the same order as they appear in the export--- list, unless there is no export list, in which case they appear in the same--- order as they do in the source file.----exportedDeclarations :: Module -> [Declaration]-exportedDeclarations (Module _ _ mn decls exps) = go decls-  where-  go = flattenDecls-        >>> filter (isExported exps)-        >>> map (filterDataConstructors exps)-        >>> filterInstances mn exps-        >>> maybe id reorder exps---- |--- Filter out all data constructors from a declaration which are not exported.--- If the supplied declaration is not a data declaration, this function returns--- it unchanged.----filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration-filterDataConstructors exps (DataDeclaration sa dType tyName tyArgs dctors) =-  DataDeclaration sa dType tyName tyArgs $-    filter (isDctorExported tyName exps . dataCtorName) dctors-filterDataConstructors _ other = other---- |--- Filter out all the type instances from a list of declarations which--- reference a type or type class which is both local and not exported.------ Note that this function assumes that the module has already had its imports--- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will--- produce incorrect results if this is not the case - for example, type class--- instances will be incorrectly removed in some cases.----filterInstances-  :: ModuleName-  -> Maybe [DeclarationRef]-  -> [Declaration]-  -> [Declaration]-filterInstances _ Nothing = id-filterInstances mn (Just exps) =-  let refs = Left `map` mapMaybe typeClassName exps-          ++ Right `map` mapMaybe typeName exps-  in filter (all (visibleOutside refs) . typeInstanceConstituents)-  where-  -- Given a Qualified ProperName, and a list of all exported types and type-  -- classes, returns whether the supplied Qualified ProperName is visible-  -- outside this module. This is true if one of the following hold:-  ---  --  * the name is defined in the same module and is exported,-  --  * the name is defined in a different module (and must be exported from-  --    that module; the code would fail to compile otherwise).-  visibleOutside-    :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]-    -> Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))-    -> Bool-  visibleOutside refs q-    | either checkQual checkQual q = True-    | otherwise = either (Left . disqualify) (Right . disqualify) q `elem` refs--  -- Check that a qualified name is qualified for a different module-  checkQual :: Qualified a -> Bool-  checkQual q = isQualified q && not (isQualifiedWith mn q)--  typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)-  typeName (TypeRef _ n _) = Just n-  typeName _ = Nothing--  typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)-  typeClassName (TypeClassRef _ n) = Just n-  typeClassName _ = Nothing---- |--- Get all type and type class names referenced by a type instance declaration.----typeInstanceConstituents :: Declaration -> [Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))]-typeInstanceConstituents (TypeInstanceDeclaration _ _ _ _ constraints className tys _) =-  Left className : (concatMap fromConstraint constraints ++ concatMap fromType tys)-  where--  fromConstraint c = Left (constraintClass c) : concatMap fromType (constraintArgs c)-  fromType = everythingOnTypes (++) go--  -- Note that type synonyms are disallowed in instance declarations, so-  -- we don't need to handle them here.-  go (TypeConstructor _ n) = [Right n]-  go (ConstrainedType _ c _) = fromConstraint c-  go _ = []--typeInstanceConstituents _ = []----- |--- Test if a declaration is exported, given a module's export list. Note that--- this function does not account for type instance declarations of--- non-exported types, or non-exported data constructors. Therefore, you should--- prefer 'exportedDeclarations' to this function, where possible.----isExported :: Maybe [DeclarationRef] -> Declaration -> Bool-isExported Nothing _ = True-isExported _ TypeInstanceDeclaration{} = True-isExported (Just exps) decl = any matches exps-  where-  matches declRef = declName decl == Just (declRefName declRef)---- |--- Test if a data constructor for a given type is exported, given a module's--- export list. Prefer 'exportedDeclarations' to this function, where possible.----isDctorExported :: ProperName 'TypeName -> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool-isDctorExported _ Nothing _ = True-isDctorExported ident (Just exps) ctor = test `any` exps-  where-  test (TypeRef _ ident' Nothing) = ident == ident'-  test (TypeRef _ ident' (Just ctors)) = ident == ident' && ctor `elem` ctors-  test _ = False---- |--- Reorder declarations based on the order they appear in the given export--- list.----reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]-reorder refs =-  sortBy (compare `on` refIndex)-  where-  refIndices =-    M.fromList $ zip (map declRefName refs) [(0::Int)..]-  refIndex decl =-    declName decl >>= flip M.lookup refIndices
− src/Language/PureScript/AST/Literals.hs 
@@ -1,38 +0,0 @@--- |--- The core functional representation for literal values.----module Language.PureScript.AST.Literals where--import Prelude.Compat-import Language.PureScript.PSString (PSString)---- |--- Data type for literal values. Parameterised so it can be used for Exprs and--- Binders.----data Literal a-  -- |-  -- A numeric literal-  ---  = NumericLiteral (Either Integer Double)-  -- |-  -- A string literal-  ---  | StringLiteral PSString-  -- |-  -- A character literal-  ---  | CharLiteral Char-  -- |-  -- A boolean literal-  ---  | BooleanLiteral Bool-  -- |-  -- An array literal-  ---  | ArrayLiteral [a]-  -- |-  -- An object literal-  ---  | ObjectLiteral [(PSString, a)]-  deriving (Eq, Ord, Show, Functor)
− src/Language/PureScript/AST/Operators.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--- |--- Operators fixity and associativity----module Language.PureScript.AST.Operators where--import Prelude.Compat--import Codec.Serialise (Serialise)-import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import Data.Aeson ((.=))-import qualified Data.Aeson as A--import Language.PureScript.Crash---- |--- A precedence level for an infix operator----type Precedence = Integer---- |--- Associativity for infix operators----data Associativity = Infixl | Infixr | Infix-  deriving (Show, Eq, Ord, Generic)--instance NFData Associativity-instance Serialise Associativity--showAssoc :: Associativity -> String-showAssoc Infixl = "infixl"-showAssoc Infixr = "infixr"-showAssoc Infix  = "infix"--readAssoc :: String -> Associativity-readAssoc "infixl" = Infixl-readAssoc "infixr" = Infixr-readAssoc "infix"  = Infix-readAssoc _ = internalError "readAssoc: no parse"--instance A.ToJSON Associativity where-  toJSON = A.toJSON . showAssoc--instance A.FromJSON Associativity where-  parseJSON = fmap readAssoc . A.parseJSON---- |--- Fixity data for infix operators----data Fixity = Fixity Associativity Precedence-  deriving (Show, Eq, Ord, Generic)--instance NFData Fixity-instance Serialise Fixity--instance A.ToJSON Fixity where-  toJSON (Fixity associativity precedence) =-    A.object [ "associativity" .= associativity-             , "precedence" .= precedence-             ]
− src/Language/PureScript/AST/SourcePos.hs 
@@ -1,119 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}--- |--- Source position information----module Language.PureScript.AST.SourcePos where--import Prelude.Compat--import Codec.Serialise (Serialise)-import Control.DeepSeq (NFData)-import Data.Aeson ((.=), (.:))-import Data.Text (Text)-import GHC.Generics (Generic)-import Language.PureScript.Comments-import qualified Data.Aeson as A-import qualified Data.Text as T-import System.FilePath (makeRelative)---- | Source annotation - position information and comments.-type SourceAnn = (SourceSpan, [Comment])---- | Source position information-data SourcePos = SourcePos-  { sourcePosLine :: Int-    -- ^ Line number-  , sourcePosColumn :: Int-    -- ^ Column number-  } deriving (Show, Eq, Ord, Generic, NFData, Serialise)--displaySourcePos :: SourcePos -> Text-displaySourcePos sp =-  "line " <> T.pack (show (sourcePosLine sp)) <>-    ", column " <> T.pack (show (sourcePosColumn sp))--displaySourcePosShort :: SourcePos -> Text-displaySourcePosShort sp =-  T.pack (show (sourcePosLine sp)) <>-    ":" <> T.pack (show (sourcePosColumn sp))--instance A.ToJSON SourcePos where-  toJSON SourcePos{..} =-    A.toJSON [sourcePosLine, sourcePosColumn]--instance A.FromJSON SourcePos where-  parseJSON arr = do-    [line, col] <- A.parseJSON arr-    return $ SourcePos line col--data SourceSpan = SourceSpan-  { spanName :: String-    -- ^ Source name-  , spanStart :: SourcePos-    -- ^ Start of the span-  , spanEnd :: SourcePos-    -- ^ End of the span-  } deriving (Show, Eq, Ord, Generic, NFData, Serialise)--displayStartEndPos :: SourceSpan -> Text-displayStartEndPos sp =-  "(" <>-  displaySourcePos (spanStart sp) <> " - " <>-  displaySourcePos (spanEnd sp) <> ")"--displayStartEndPosShort :: SourceSpan -> Text-displayStartEndPosShort sp =-  displaySourcePosShort (spanStart sp) <> " - " <>-  displaySourcePosShort (spanEnd sp)--displaySourceSpan :: FilePath -> SourceSpan -> Text-displaySourceSpan relPath sp =-  T.pack (makeRelative relPath (spanName sp)) <> ":" <>-    displayStartEndPosShort sp <> " " <>-    displayStartEndPos sp--instance A.ToJSON SourceSpan where-  toJSON SourceSpan{..} =-    A.object [ "name"  .= spanName-             , "start" .= spanStart-             , "end"   .= spanEnd-             ]--instance A.FromJSON SourceSpan where-  parseJSON = A.withObject "SourceSpan" $ \o ->-    SourceSpan     <$>-      o .: "name"  <*>-      o .: "start" <*>-      o .: "end"--internalModuleSourceSpan :: String -> SourceSpan-internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)--nullSourceSpan :: SourceSpan-nullSourceSpan = internalModuleSourceSpan ""--nullSourceAnn :: SourceAnn-nullSourceAnn = (nullSourceSpan, [])--pattern NullSourceSpan :: SourceSpan-pattern NullSourceSpan = SourceSpan "" (SourcePos 0 0) (SourcePos 0 0)--pattern NullSourceAnn :: SourceAnn-pattern NullSourceAnn = (NullSourceSpan, [])--nonEmptySpan :: SourceAnn -> Maybe SourceSpan-nonEmptySpan (NullSourceSpan, _) = Nothing-nonEmptySpan (ss, _) = Just ss--widenSourceSpan :: SourceSpan -> SourceSpan -> SourceSpan-widenSourceSpan NullSourceSpan b = b-widenSourceSpan a NullSourceSpan = a-widenSourceSpan (SourceSpan n1 s1 e1) (SourceSpan n2 s2 e2) =-  SourceSpan n (min s1 s2) (max e1 e2)-  where-  n | n1 == ""  = n2-    | otherwise = n1--widenSourceAnn :: SourceAnn -> SourceAnn -> SourceAnn-widenSourceAnn (s1, _) (s2, _) = (widenSourceSpan s1 s2, [])
− src/Language/PureScript/AST/Traversals.hs 
@@ -1,706 +0,0 @@--- |--- AST traversal helpers----module Language.PureScript.AST.Traversals where--import Prelude.Compat--import Control.Monad--import Data.Foldable (fold)-import Data.List (mapAccumL)-import Data.Maybe (mapMaybe)-import qualified Data.List.NonEmpty as NEL-import qualified Data.Map as M-import qualified Data.Set as S--import Language.PureScript.AST.Binders-import Language.PureScript.AST.Declarations-import Language.PureScript.AST.Literals-import Language.PureScript.Kinds-import Language.PureScript.Names-import Language.PureScript.Traversals-import Language.PureScript.TypeClassDictionaries (TypeClassDictionaryInScope(..))-import Language.PureScript.Types--guardedExprM :: Applicative m-             => (Guard -> m Guard)-             -> (Expr -> m Expr)-             -> GuardedExpr-             -> m GuardedExpr-guardedExprM f g (GuardedExpr guards rhs) =-  GuardedExpr <$> traverse f guards <*> g rhs--mapGuardedExpr :: (Guard -> Guard)-               -> (Expr -> Expr)-               -> GuardedExpr-               -> GuardedExpr-mapGuardedExpr f g (GuardedExpr guards rhs) =-  GuardedExpr (fmap f guards) (g rhs)--litM :: Monad m => (a -> m a) -> Literal a -> m (Literal a)-litM go (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM go) as-litM go (ArrayLiteral as) = ArrayLiteral <$> traverse go as-litM _ other = pure other--everywhereOnValues-  :: (Declaration -> Declaration)-  -> (Expr -> Expr)-  -> (Binder -> Binder)-  -> ( Declaration -> Declaration-     , Expr -> Expr-     , Binder -> Binder-     )-everywhereOnValues f g h = (f', g', h')-  where-  f' :: Declaration -> Declaration-  f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (fmap f' ds))-  f' (ValueDecl sa name nameKind bs val) =-     f (ValueDecl sa name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))-  f' (BoundValueDeclaration sa b expr) = f (BoundValueDeclaration sa (h' b) (g' expr))-  f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (fmap (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))-  f' (TypeClassDeclaration sa name args implies deps ds) = f (TypeClassDeclaration sa name args implies deps (fmap f' ds))-  f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = f (TypeInstanceDeclaration sa ch idx name cs className args (mapTypeInstanceBody (fmap f') ds))-  f' other = f other--  g' :: Expr -> Expr-  g' (Literal ss l) = g (Literal ss (lit g' l))-  g' (UnaryMinus ss v) = g (UnaryMinus ss (g' v))-  g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))-  g' (Parens v) = g (Parens (g' v))-  g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))-  g' (Accessor prop v) = g (Accessor prop (g' v))-  g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (fmap (fmap g') vs))-  g' (ObjectUpdateNested obj vs) = g (ObjectUpdateNested (g' obj) (fmap g' vs))-  g' (Abs binder v) = g (Abs (h' binder) (g' v))-  g' (App v1 v2) = g (App (g' v1) (g' v2))-  g' (Unused v) = g (Unused (g' v))-  g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))-  g' (Case vs alts) = g (Case (fmap g' vs) (fmap handleCaseAlternative alts))-  g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)-  g' (Let w ds v) = g (Let w (fmap f' ds) (g' v))-  g' (Do m es) = g (Do m (fmap handleDoNotationElement es))-  g' (Ado m es v) = g (Ado m (fmap handleDoNotationElement es) (g' v))-  g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))-  g' other = g other--  h' :: Binder -> Binder-  h' (ConstructorBinder ss ctor bs) = h (ConstructorBinder ss ctor (fmap h' bs))-  h' (BinaryNoParensBinder b1 b2 b3) = h (BinaryNoParensBinder (h' b1) (h' b2) (h' b3))-  h' (ParensInBinder b) = h (ParensInBinder (h' b))-  h' (LiteralBinder ss l) = h (LiteralBinder ss (lit h' l))-  h' (NamedBinder ss name b) = h (NamedBinder ss name (h' b))-  h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))-  h' (TypedBinder t b) = h (TypedBinder t (h' b))-  h' other = h other--  lit :: (a -> a) -> Literal a -> Literal a-  lit go (ArrayLiteral as) = ArrayLiteral (fmap go as)-  lit go (ObjectLiteral as) = ObjectLiteral (fmap (fmap go) as)-  lit _ other = other--  handleCaseAlternative :: CaseAlternative -> CaseAlternative-  handleCaseAlternative ca =-    ca { caseAlternativeBinders = fmap h' (caseAlternativeBinders ca)-       , caseAlternativeResult = fmap (mapGuardedExpr handleGuard g') (caseAlternativeResult ca)-       }--  handleDoNotationElement :: DoNotationElement -> DoNotationElement-  handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)-  handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)-  handleDoNotationElement (DoNotationLet ds) = DoNotationLet (fmap f' ds)-  handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)--  handleGuard :: Guard -> Guard-  handleGuard (ConditionGuard e) = ConditionGuard (g' e)-  handleGuard (PatternGuard b e) = PatternGuard (h' b) (g' e)--everywhereOnValuesTopDownM-  :: forall m-   . (Monad m)-  => (Declaration -> m Declaration)-  -> (Expr -> m Expr)-  -> (Binder -> m Binder)-  -> ( Declaration -> m Declaration-     , Expr -> m Expr-     , Binder -> m Binder-     )-everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)-  where--  f' :: Declaration -> m Declaration-  f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds-  f' (ValueDecl sa name nameKind bs val) =-     ValueDecl sa name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val-  f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds-  f' (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f' <=< f) ds-  f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds-  f' (BoundValueDeclaration sa b expr) = BoundValueDeclaration sa <$> (h' <=< h) b <*> (g' <=< g) expr-  f' other = f other--  g' :: Expr -> m Expr-  g' (Literal ss l) = Literal ss <$> litM (g >=> g') l-  g' (UnaryMinus ss v) = UnaryMinus ss <$> (g v >>= g')-  g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')-  g' (Parens v) = Parens <$> (g v >>= g')-  g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')-  g' (Accessor prop v) = Accessor prop <$> (g v >>= g')-  g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs-  g' (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> (g obj >>= g') <*> traverse (g' <=< g) vs-  g' (Abs binder v) = Abs <$> (h binder >>= h') <*> (g v >>= g')-  g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')-  g' (Unused v) = Unused <$> (g v >>= g')-  g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')-  g' (Case vs alts) = Case <$> traverse (g' <=< g) vs <*> traverse handleCaseAlternative alts-  g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty-  g' (Let w ds v) = Let w <$> traverse (f' <=< f) ds <*> (g v >>= g')-  g' (Do m es) = Do m <$> traverse handleDoNotationElement es-  g' (Ado m es v) = Ado m <$> traverse handleDoNotationElement es <*> (g v >>= g')-  g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')-  g' other = g other--  h' :: Binder -> m Binder-  h' (LiteralBinder ss l) = LiteralBinder ss <$> litM (h >=> h') l-  h' (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h' <=< h) bs-  h' (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> (h b1 >>= h') <*> (h b2 >>= h') <*> (h b3 >>= h')-  h' (ParensInBinder b) = ParensInBinder <$> (h b >>= h')-  h' (NamedBinder ss name b) = NamedBinder ss name <$> (h b >>= h')-  h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')-  h' (TypedBinder t b) = TypedBinder t <$> (h b >>= h')-  h' other = h other--  handleCaseAlternative :: CaseAlternative -> m CaseAlternative-  handleCaseAlternative (CaseAlternative bs val) =-    CaseAlternative-      <$> traverse (h' <=< h) bs-      <*> traverse (guardedExprM handleGuard (g' <=< g)) val--  handleDoNotationElement :: DoNotationElement -> m DoNotationElement-  handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v-  handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v-  handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> traverse (f' <=< f) ds-  handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e--  handleGuard :: Guard -> m Guard-  handleGuard (ConditionGuard e) = ConditionGuard <$> (g' <=< g) e-  handleGuard (PatternGuard b e) = PatternGuard <$> (h' <=< h) b <*> (g' <=< g) e--everywhereOnValuesM-  :: forall m-   . (Monad m)-  => (Declaration -> m Declaration)-  -> (Expr -> m Expr)-  -> (Binder -> m Binder)-  -> ( Declaration -> m Declaration-     , Expr -> m Expr-     , Binder -> m Binder-     )-everywhereOnValuesM f g h = (f', g', h')-  where--  f' :: Declaration -> m Declaration-  f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f-  f' (ValueDecl sa name nameKind bs val) =-    ValueDecl sa name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val >>= f-  f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f-  f' (BoundValueDeclaration sa b expr) = (BoundValueDeclaration sa <$> h' b <*> g' expr) >>= f-  f' (TypeClassDeclaration sa name args implies deps ds) = (TypeClassDeclaration sa name args implies deps <$> traverse f' ds) >>= f-  f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = (TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f-  f' other = f other--  g' :: Expr -> m Expr-  g' (Literal ss l) = (Literal ss <$> litM g' l) >>= g-  g' (UnaryMinus ss v) = (UnaryMinus ss <$> g' v) >>= g-  g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g-  g' (Parens v) = (Parens <$> g' v) >>= g-  g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g-  g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g-  g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g-  g' (ObjectUpdateNested obj vs) = (ObjectUpdateNested <$> g' obj <*> traverse g' vs) >>= g-  g' (Abs binder v) = (Abs <$> h' binder <*> g' v) >>= g-  g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g-  g' (Unused v) = (Unused <$> g' v) >>= g-  g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g-  g' (Case vs alts) = (Case <$> traverse g' vs <*> traverse handleCaseAlternative alts) >>= g-  g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g-  g' (Let w ds v) = (Let w <$> traverse f' ds <*> g' v) >>= g-  g' (Do m es) = (Do m <$> traverse handleDoNotationElement es) >>= g-  g' (Ado m es v) = (Ado m <$> traverse handleDoNotationElement es <*> g' v) >>= g-  g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g-  g' other = g other--  h' :: Binder -> m Binder-  h' (LiteralBinder ss l) = (LiteralBinder ss <$> litM h' l) >>= h-  h' (ConstructorBinder ss ctor bs) = (ConstructorBinder ss ctor <$> traverse h' bs) >>= h-  h' (BinaryNoParensBinder b1 b2 b3) = (BinaryNoParensBinder <$> h' b1 <*> h' b2 <*> h' b3) >>= h-  h' (ParensInBinder b) = (ParensInBinder <$> h' b) >>= h-  h' (NamedBinder ss name b) = (NamedBinder ss name <$> h' b) >>= h-  h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h-  h' (TypedBinder t b) = (TypedBinder t <$> h' b) >>= h-  h' other = h other--  handleCaseAlternative :: CaseAlternative -> m CaseAlternative-  handleCaseAlternative (CaseAlternative bs val) =-    CaseAlternative-      <$> traverse h' bs-      <*> traverse (guardedExprM handleGuard g') val--  handleDoNotationElement :: DoNotationElement -> m DoNotationElement-  handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v-  handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v-  handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> traverse f' ds-  handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e--  handleGuard :: Guard -> m Guard-  handleGuard (ConditionGuard e) = ConditionGuard <$> g' e-  handleGuard (PatternGuard b e) = PatternGuard <$> h' b <*> g' e--everythingOnValues-  :: forall r-   . (r -> r -> r)-  -> (Declaration -> r)-  -> (Expr -> r)-  -> (Binder -> r)-  -> (CaseAlternative -> r)-  -> (DoNotationElement -> r)-  -> ( Declaration -> r-     , Expr -> r-     , Binder -> r-     , CaseAlternative -> r-     , DoNotationElement -> r-     )-everythingOnValues (<>.) f g h i j = (f', g', h', i', j')-  where--  f' :: Declaration -> r-  f' d@(DataBindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap f' ds)-  f' d@(ValueDeclaration vd) = foldl (<>.) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))-  f' d@(BindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap (\(_, _, val) -> g' val) ds)-  f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) (f d) (fmap f' ds)-  f' d@(TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) (f d) (fmap f' ds)-  f' d@(BoundValueDeclaration _ b expr) = f d <>. h' b <>. g' expr-  f' d = f d--  g' :: Expr -> r-  g' v@(Literal _ l) = lit (g v) g' l-  g' v@(UnaryMinus _ v1) = g v <>. g' v1-  g' v@(BinaryNoParens op v1 v2) = g v <>. g' op <>. g' v1 <>. g' v2-  g' v@(Parens v1) = g v <>. g' v1-  g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <>. g' v1-  g' v@(Accessor _ v1) = g v <>. g' v1-  g' v@(ObjectUpdate obj vs) = foldl (<>.) (g v <>. g' obj) (fmap (g' . snd) vs)-  g' v@(ObjectUpdateNested obj vs) = foldl (<>.) (g v <>. g' obj) (fmap g' vs)-  g' v@(Abs b v1) = g v <>. h' b <>. g' v1-  g' v@(App v1 v2) = g v <>. g' v1 <>. g' v2-  g' v@(Unused v1) = g v <>. g' v1-  g' v@(IfThenElse v1 v2 v3) = g v <>. g' v1 <>. g' v2 <>. g' v3-  g' v@(Case vs alts) = foldl (<>.) (foldl (<>.) (g v) (fmap g' vs)) (fmap i' alts)-  g' v@(TypedValue _ v1 _) = g v <>. g' v1-  g' v@(Let _ ds v1) = foldl (<>.) (g v) (fmap f' ds) <>. g' v1-  g' v@(Do _ es) = foldl (<>.) (g v) (fmap j' es)-  g' v@(Ado _ es v1) = foldl (<>.) (g v) (fmap j' es) <>. g' v1-  g' v@(PositionedValue _ _ v1) = g v <>. g' v1-  g' v = g v--  h' :: Binder -> r-  h' b@(LiteralBinder _ l) = lit (h b) h' l-  h' b@(ConstructorBinder _ _ bs) = foldl (<>.) (h b) (fmap h' bs)-  h' b@(BinaryNoParensBinder b1 b2 b3) = h b <>. h' b1 <>. h' b2 <>. h' b3-  h' b@(ParensInBinder b1) = h b <>. h' b1-  h' b@(NamedBinder _ _ b1) = h b <>. h' b1-  h' b@(PositionedBinder _ _ b1) = h b <>. h' b1-  h' b@(TypedBinder _ b1) = h b <>. h' b1-  h' b = h b--  lit :: r -> (a -> r) -> Literal a -> r-  lit r go (ArrayLiteral as) = foldl (<>.) r (fmap go as)-  lit r go (ObjectLiteral as) = foldl (<>.) r (fmap (go . snd) as)-  lit r _ _ = r--  i' :: CaseAlternative -> r-  i' ca@(CaseAlternative bs gs) =-    foldl (<>.) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)--  j' :: DoNotationElement -> r-  j' e@(DoNotationValue v) = j e <>. g' v-  j' e@(DoNotationBind b v) = j e <>. h' b <>. g' v-  j' e@(DoNotationLet ds) = foldl (<>.) (j e) (fmap f' ds)-  j' e@(PositionedDoNotationElement _ _ e1) = j e <>. j' e1--  k' :: Guard -> r-  k' (ConditionGuard e) = g' e-  k' (PatternGuard b e) = h' b <>. g' e--everythingWithContextOnValues-  :: forall s r-   . s-  -> r-  -> (r -> r -> r)-  -> (s -> Declaration       -> (s, r))-  -> (s -> Expr              -> (s, r))-  -> (s -> Binder            -> (s, r))-  -> (s -> CaseAlternative   -> (s, r))-  -> (s -> DoNotationElement -> (s, r))-  -> ( Declaration       -> r-     , Expr              -> r-     , Binder            -> r-     , CaseAlternative   -> r-     , DoNotationElement -> r)-everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)-  where--  f'' :: s -> Declaration -> r-  f'' s d = let (s', r) = f s d in r <>. f' s' d--  f' :: s -> Declaration -> r-  f' s (DataBindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (f'' s) ds)-  f' s (ValueDeclaration vd) = foldl (<>.) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))-  f' s (BindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (\(_, _, val) -> g'' s val) ds)-  f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) r0 (fmap (f'' s) ds)-  f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) r0 (fmap (f'' s) ds)-  f' _ _ = r0--  g'' :: s -> Expr -> r-  g'' s v = let (s', r) = g s v in r <>. g' s' v--  g' :: s -> Expr -> r-  g' s (Literal _ l) = lit g'' s l-  g' s (UnaryMinus _ v1) = g'' s v1-  g' s (BinaryNoParens op v1 v2) = g'' s op <>. g'' s v1 <>. g'' s v2-  g' s (Parens v1) = g'' s v1-  g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1-  g' s (Accessor _ v1) = g'' s v1-  g' s (ObjectUpdate obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s . snd) vs)-  g' s (ObjectUpdateNested obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s) vs)-  g' s (Abs binder v1) = h'' s binder <>. g'' s v1-  g' s (App v1 v2) = g'' s v1 <>. g'' s v2-  g' s (Unused v) = g'' s v-  g' s (IfThenElse v1 v2 v3) = g'' s v1 <>. g'' s v2 <>. g'' s v3-  g' s (Case vs alts) = foldl (<>.) (foldl (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)-  g' s (TypedValue _ v1 _) = g'' s v1-  g' s (Let _ ds v1) = foldl (<>.) r0 (fmap (f'' s) ds) <>. g'' s v1-  g' s (Do _ es) = foldl (<>.) r0 (fmap (j'' s) es)-  g' s (Ado _ es v1) = foldl (<>.) r0 (fmap (j'' s) es) <>. g'' s v1-  g' s (PositionedValue _ _ v1) = g'' s v1-  g' _ _ = r0--  h'' :: s -> Binder -> r-  h'' s b = let (s', r) = h s b in r <>. h' s' b--  h' :: s -> Binder -> r-  h' s (LiteralBinder _ l) = lit h'' s l-  h' s (ConstructorBinder _ _ bs) = foldl (<>.) r0 (fmap (h'' s) bs)-  h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <>. h'' s b2 <>. h'' s b3-  h' s (ParensInBinder b) = h'' s b-  h' s (NamedBinder _ _ b1) = h'' s b1-  h' s (PositionedBinder _ _ b1) = h'' s b1-  h' s (TypedBinder _ b1) = h'' s b1-  h' _ _ = r0--  lit :: (s -> a -> r) -> s -> Literal a -> r-  lit go s (ArrayLiteral as) = foldl (<>.) r0 (fmap (go s) as)-  lit go s (ObjectLiteral as) = foldl (<>.) r0 (fmap (go s . snd) as)-  lit _ _ _ = r0--  i'' :: s -> CaseAlternative -> r-  i'' s ca = let (s', r) = i s ca in r <>. i' s' ca--  i' :: s -> CaseAlternative -> r-  i' s (CaseAlternative bs gs) = foldl (<>.) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)--  j'' :: s -> DoNotationElement -> r-  j'' s e = let (s', r) = j s e in r <>. j' s' e--  j' :: s -> DoNotationElement -> r-  j' s (DoNotationValue v) = g'' s v-  j' s (DoNotationBind b v) = h'' s b <>. g'' s v-  j' s (DoNotationLet ds) = foldl (<>.) r0 (fmap (f'' s) ds)-  j' s (PositionedDoNotationElement _ _ e1) = j'' s e1--  k' :: s -> Guard -> r-  k' s (ConditionGuard e) = g'' s e-  k' s (PatternGuard b e) = h'' s b <>. g'' s e--everywhereWithContextOnValuesM-  :: forall m s-   . (Monad m)-  => s-  -> (s -> Declaration       -> m (s, Declaration))-  -> (s -> Expr              -> m (s, Expr))-  -> (s -> Binder            -> m (s, Binder))-  -> (s -> CaseAlternative   -> m (s, CaseAlternative))-  -> (s -> DoNotationElement -> m (s, DoNotationElement))-  -> ( Declaration       -> m Declaration-     , Expr              -> m Expr-     , Binder            -> m Binder-     , CaseAlternative   -> m CaseAlternative-     , DoNotationElement -> m DoNotationElement-     )-everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)-  where-  f'' s = uncurry f' <=< f s--  f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds-  f' s (ValueDecl sa name nameKind bs val) =-    ValueDecl sa name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val-  f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds-  f' s (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f'' s) ds-  f' s (TypeInstanceDeclaration sa ch idx name cs className args ds) = TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds-  f' _ other = return other--  g'' s = uncurry g' <=< g s--  g' s (Literal ss l) = Literal ss <$> lit g'' s l-  g' s (UnaryMinus ss v) = UnaryMinus ss <$> g'' s v-  g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2-  g' s (Parens v) = Parens <$> g'' s v-  g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v-  g' s (Accessor prop v) = Accessor prop <$> g'' s v-  g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs-  g' s (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> g'' s obj <*> traverse (g'' s) vs-  g' s (Abs binder v) = Abs <$> h' s binder <*> g'' s v-  g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2-  g' s (Unused v) = Unused <$> g'' s v-  g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3-  g' s (Case vs alts) = Case <$> traverse (g'' s) vs <*> traverse (i'' s) alts-  g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty-  g' s (Let w ds v) = Let w <$> traverse (f'' s) ds <*> g'' s v-  g' s (Do m es) = Do m <$> traverse (j'' s) es-  g' s (Ado m es v) = Ado m <$> traverse (j'' s) es <*> g'' s v-  g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v-  g' _ other = return other--  h'' s = uncurry h' <=< h s--  h' s (LiteralBinder ss l) = LiteralBinder ss <$> lit h'' s l-  h' s (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h'' s) bs-  h' s (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> h'' s b1 <*> h'' s b2 <*> h'' s b3-  h' s (ParensInBinder b) = ParensInBinder <$> h'' s b-  h' s (NamedBinder ss name b) = NamedBinder ss name <$> h'' s b-  h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b-  h' s (TypedBinder t b) = TypedBinder t <$> h'' s b-  h' _ other = return other--  lit :: (s -> a -> m a) -> s -> Literal a -> m (Literal a)-  lit go s (ArrayLiteral as) = ArrayLiteral <$> traverse (go s) as-  lit go s (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM (go s)) as-  lit _ _ other = return other--  i'' s = uncurry i' <=< i s--  i' s (CaseAlternative bs val) = CaseAlternative <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val--  j'' s = uncurry j' <=< j s--  j' s (DoNotationValue v) = DoNotationValue <$> g'' s v-  j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v-  j' s (DoNotationLet ds) = DoNotationLet <$> traverse (f'' s) ds-  j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1--  k' s (ConditionGuard e) = ConditionGuard <$> g'' s e-  k' s (PatternGuard b e) = PatternGuard <$> h'' s b <*> g'' s e--data ScopedIdent = LocalIdent Ident | ToplevelIdent Ident-  deriving (Show, Eq, Ord)--inScope :: Ident -> S.Set ScopedIdent -> Bool-inScope i s = (LocalIdent i `S.member` s) || (ToplevelIdent i `S.member` s)--everythingWithScope-  :: forall r-   . (Monoid r)-  => (S.Set ScopedIdent -> Declaration -> r)-  -> (S.Set ScopedIdent -> Expr -> r)-  -> (S.Set ScopedIdent -> Binder -> r)-  -> (S.Set ScopedIdent -> CaseAlternative -> r)-  -> (S.Set ScopedIdent -> DoNotationElement -> r)-  -> ( S.Set ScopedIdent -> Declaration -> r-     , S.Set ScopedIdent -> Expr -> r-     , S.Set ScopedIdent -> Binder -> r-     , S.Set ScopedIdent -> CaseAlternative -> r-     , S.Set ScopedIdent -> DoNotationElement -> r-     )-everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)-  where-  f'' :: S.Set ScopedIdent -> Declaration -> r-  f'' s a = f s a <> f' s a--  f' :: S.Set ScopedIdent -> Declaration -> r-  f' s (DataBindingGroupDeclaration ds) =-    let s' = S.union s (S.fromList (map ToplevelIdent (mapMaybe getDeclIdent (NEL.toList ds))))-    in foldMap (f'' s') ds-  f' s (ValueDecl _ name _ bs val) =-    let s' = S.insert (ToplevelIdent name) s-        s'' = S.union s' (S.fromList (concatMap localBinderNames bs))-    in foldMap (h'' s') bs <> foldMap (l' s'') val-  f' s (BindingGroupDeclaration ds) =-    let s' = S.union s (S.fromList (NEL.toList (fmap (\((_, name), _, _) -> ToplevelIdent name) ds)))-    in foldMap (\(_, _, val) -> g'' s' val) ds-  f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldMap (f'' s) ds-  f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds-  f' _ _ = mempty--  g'' :: S.Set ScopedIdent -> Expr -> r-  g'' s a = g s a <> g' s a--  g' :: S.Set ScopedIdent -> Expr -> r-  g' s (Literal _ l) = lit g'' s l-  g' s (UnaryMinus _ v1) = g'' s v1-  g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2-  g' s (Parens v1) = g'' s v1-  g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1-  g' s (Accessor _ v1) = g'' s v1-  g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs-  g' s (ObjectUpdateNested obj vs) = g'' s obj <> foldMap (g'' s) vs-  g' s (Abs b v1) =-    let s' = S.union (S.fromList (localBinderNames b)) s-    in h'' s b <> g'' s' v1-  g' s (App v1 v2) = g'' s v1 <> g'' s v2-  g' s (Unused v) = g'' s v-  g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3-  g' s (Case vs alts) = foldMap (g'' s) vs <> foldMap (i'' s) alts-  g' s (TypedValue _ v1 _) = g'' s v1-  g' s (Let _ ds v1) =-    let s' = S.union s (S.fromList (map LocalIdent (mapMaybe getDeclIdent ds)))-    in foldMap (f'' s') ds <> g'' s' v1-  g' s (Do _ es) = fold . snd . mapAccumL j'' s $ es-  g' s (Ado _ es v1) =-    let s' = S.union s (foldMap (fst . j'' s) es)-    in g'' s' v1-  g' s (PositionedValue _ _ v1) = g'' s v1-  g' _ _ = mempty--  h'' :: S.Set ScopedIdent -> Binder -> r-  h'' s a = h s a <> h' s a--  h' :: S.Set ScopedIdent -> Binder -> r-  h' s (LiteralBinder _ l) = lit h'' s l-  h' s (ConstructorBinder _ _ bs) = foldMap (h'' s) bs-  h' s (BinaryNoParensBinder b1 b2 b3) = foldMap (h'' s) [b1, b2, b3]-  h' s (ParensInBinder b) = h'' s b-  h' s (NamedBinder _ name b1) = h'' (S.insert (LocalIdent name) s) b1-  h' s (PositionedBinder _ _ b1) = h'' s b1-  h' s (TypedBinder _ b1) = h'' s b1-  h' _ _ = mempty--  lit :: (S.Set ScopedIdent -> a -> r) -> S.Set ScopedIdent -> Literal a -> r-  lit go s (ArrayLiteral as) = foldMap (go s) as-  lit go s (ObjectLiteral as) = foldMap (go s . snd) as-  lit _ _ _ = mempty--  i'' :: S.Set ScopedIdent -> CaseAlternative -> r-  i'' s a = i s a <> i' s a--  i' :: S.Set ScopedIdent -> CaseAlternative -> r-  i' s (CaseAlternative bs gs) =-    let s' = S.union s (S.fromList (concatMap localBinderNames bs))-    in foldMap (h'' s) bs <> foldMap (l' s') gs--  j'' :: S.Set ScopedIdent -> DoNotationElement -> (S.Set ScopedIdent, r)-  j'' s a = let (s', r) = j' s a in (s', j s a <> r)--  j' :: S.Set ScopedIdent -> DoNotationElement -> (S.Set ScopedIdent, r)-  j' s (DoNotationValue v) = (s, g'' s v)-  j' s (DoNotationBind b v) =-    let s' = S.union (S.fromList (localBinderNames b)) s-    in (s', h'' s b <> g'' s v)-  j' s (DoNotationLet ds) =-    let s' = S.union s (S.fromList (map LocalIdent (mapMaybe getDeclIdent ds)))-    in (s', foldMap (f'' s') ds)-  j' s (PositionedDoNotationElement _ _ e1) = j'' s e1--  k' :: S.Set ScopedIdent -> Guard -> (S.Set ScopedIdent, r)-  k' s (ConditionGuard e) = (s, g'' s e)-  k' s (PatternGuard b e) =-    let s' = S.union (S.fromList (localBinderNames b)) s-    in (s', h'' s b <> g'' s' e)--  l' s (GuardedExpr [] e) = g'' s e-  l' s (GuardedExpr (grd:gs) e) =-    let (s', r) = k' s grd-    in r <> l' s' (GuardedExpr gs e)--  getDeclIdent :: Declaration -> Maybe Ident-  getDeclIdent (ValueDeclaration vd) = Just (valdeclIdent vd)-  getDeclIdent (TypeDeclaration td) = Just (tydeclIdent td)-  getDeclIdent _ = Nothing--  localBinderNames = map LocalIdent . binderNames--accumTypes-  :: (Monoid r)-  => (SourceType -> r)-  -> ( Declaration -> r-     , Expr -> r-     , Binder -> r-     , CaseAlternative -> r-     , DoNotationElement -> r-     )-accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)-  where-  forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap (f . snd) . dataCtorFields) dctors)-  forDecls (ExternDeclaration _ _ ty) = f ty-  forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)-  forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) <> mconcat (fmap f tys)-  forDecls (TypeSynonymDeclaration _ _ _ ty) = f ty-  forDecls (TypeDeclaration td) = f (tydeclType td)-  forDecls _ = mempty--  forValues (TypeClassDictionary c _ _) = mconcat (fmap f (constraintArgs c))-  forValues (DeferredDictionary _ tys) = mconcat (fmap f tys)-  forValues (TypedValue _ _ ty) = f ty-  forValues _ = mempty--accumKinds-  :: (Monoid r)-  => (SourceKind -> r)-  -> ( Declaration -> r-     , Expr -> r-     , Binder -> r-     , CaseAlternative -> r-     , DoNotationElement -> r-     )-accumKinds f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)-  where-  forDecls (DataDeclaration _ _ _ args dctors) =-    foldMap (foldMap f . snd) args <>-    foldMap (foldMap (forTypes . snd) . dataCtorFields) dctors-  forDecls (TypeClassDeclaration _ _ args implies _ _) =-    foldMap (foldMap f . snd) args <>-    foldMap (foldMap forTypes . constraintArgs) implies-  forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) =-    foldMap (foldMap forTypes . constraintArgs) cs <>-    foldMap forTypes tys-  forDecls (TypeSynonymDeclaration _ _ args ty) =-    foldMap (foldMap f . snd) args <>-    forTypes ty-  forDecls (TypeDeclaration td) = forTypes (tydeclType td)-  forDecls (ExternDeclaration _ _ ty) = forTypes ty-  forDecls (ExternDataDeclaration _ _ kn) = f kn-  forDecls _ = mempty--  forValues (TypeClassDictionary c _ _) = foldMap forTypes (constraintArgs c)-  forValues (DeferredDictionary _ tys) = foldMap forTypes tys-  forValues (TypedValue _ _ ty) = forTypes ty-  forValues _ = mempty--  forTypes (KindedType _ _ k) = f k-  forTypes _ = mempty---- |--- Map a function over type annotations appearing inside a value----overTypes :: (SourceType -> SourceType) -> Expr -> Expr-overTypes f = let (_, f', _) = everywhereOnValues id g id in f'-  where-  g :: Expr -> Expr-  g (TypedValue checkTy val t) = TypedValue checkTy val (f t)-  g (TypeClassDictionary c sco hints) =-    TypeClassDictionary-      (mapConstraintArgs (fmap f) c)-      (updateCtx sco)-      hints-  g other = other-  updateDict fn dict = dict { tcdInstanceTypes = fn (tcdInstanceTypes dict) }-  updateScope = fmap . fmap . fmap . fmap $ updateDict $ fmap f-  updateCtx = M.alter updateScope Nothing
src/Language/PureScript/Bundle.hs view
@@ -378,6 +378,7 @@   | JSAstProgram smts _ <- top = Module mid filename <$> traverse toModuleElement smts   | otherwise = err InvalidTopLevel   where+  err :: ErrorMessage -> m a   err = throwError . ErrorInModule mid    toModuleElement :: JSStatement -> m ModuleElement@@ -401,9 +402,13 @@       exportType (JSMemberDot f _ _)         | JSIdentifier _ "$foreign" <- f         = pure ForeignReexport+        | JSIdentifier _ ident <- f+        = pure (RegularExport ident)       exportType (JSMemberSquare f _ _ _)         | JSIdentifier _ "$foreign" <- f         = pure ForeignReexport+        | JSIdentifier _ ident <- f+        = pure (RegularExport ident)       exportType (JSIdentifier _ s) = pure (RegularExport s)       exportType _ = err UnsupportedExport @@ -415,7 +420,7 @@ -- -- TODO: what if we assign to exports.foo and then later assign to -- module.exports (presumably overwriting exports.foo)?-getExportedIdentifiers :: (MonadError ErrorMessage m)+getExportedIdentifiers :: forall m. (MonadError ErrorMessage m)                           => String                           -> JSAST                           -> m [String]@@ -423,6 +428,7 @@   | JSAstProgram stmts _ <- top = concat <$> traverse go stmts   | otherwise = err InvalidTopLevel   where+  err :: ErrorMessage -> m a   err = throwError . ErrorInModule (ModuleIdentifier mname Foreign)    go stmt
src/Language/PureScript/CST.hs view
@@ -5,7 +5,9 @@   , parseModulesFromFiles   , unwrapParserError   , toMultipleErrors+  , toMultipleWarnings   , toPositionedError+  , toPositionedWarning   , pureResult   , module Language.PureScript.CST.Convert   , module Language.PureScript.CST.Errors@@ -33,7 +35,7 @@ import Language.PureScript.CST.Types  pureResult :: a -> PartialResult a-pureResult a = PartialResult a (pure a)+pureResult a = PartialResult a ([], pure a)  parseModulesFromFiles   :: forall m k@@ -52,18 +54,18 @@    . MonadError E.MultipleErrors m   => (k -> FilePath)   -> [(k, Text)]-  -> m [(k, AST.Module)]+  -> m [(k, ([ParserWarning], AST.Module))] parseFromFiles toFilePath input =   flip E.parU (handleParserError toFilePath)     . inParallel     . flip fmap input-    $ \(k, a) -> (k, parseFromFile (toFilePath k) a)+    $ \(k, a) -> (k, sequence $ parseFromFile (toFilePath k) a)  parseModuleFromFile :: FilePath -> Text -> Either (NE.NonEmpty ParserError) (PartialResult AST.Module) parseModuleFromFile fp content = fmap (convertModule fp) <$> parseModule (lex content) -parseFromFile :: FilePath -> Text -> Either (NE.NonEmpty ParserError) AST.Module-parseFromFile fp content = convertModule fp <$> parse content+parseFromFile :: FilePath -> Text -> ([ParserWarning], Either (NE.NonEmpty ParserError) AST.Module)+parseFromFile fp content = fmap (convertModule fp) <$> parse content  handleParserError   :: forall m k a@@ -87,9 +89,17 @@ toMultipleErrors fp =   E.MultipleErrors . NE.toList . fmap (toPositionedError fp) +toMultipleWarnings :: FilePath -> [ParserWarning] -> E.MultipleErrors+toMultipleWarnings fp =+  E.MultipleErrors . fmap (toPositionedWarning fp)+ toPositionedError :: FilePath -> ParserError -> E.ErrorMessage toPositionedError name perr =   E.ErrorMessage [E.positionedError $ sourceSpan name $ errRange perr] (E.ErrorParsingCSTModule perr)++toPositionedWarning :: FilePath -> ParserWarning -> E.ErrorMessage+toPositionedWarning name perr =+  E.ErrorMessage [E.positionedError $ sourceSpan name $ errRange perr] (E.WarningParsingCSTModule perr)  inParallel :: [(k, Either (NE.NonEmpty ParserError) a)] -> [(k, Either (NE.NonEmpty ParserError) a)] inParallel = withStrategy (parList (evalTuple2 r0 rseq))
− src/Language/PureScript/CST/Convert.hs 
@@ -1,639 +0,0 @@--- | This module contains functions for converting the CST into the core AST. It--- is mostly boilerplate, and does the job of resolving ranges for all the nodes--- and attaching comments.--module Language.PureScript.CST.Convert-  ( convertKind-  , convertType-  , convertExpr-  , convertBinder-  , convertDeclaration-  , convertImportDecl-  , convertModule-  , sourcePos-  , sourceSpan-  , comment-  , comments-  ) where--import Prelude--import Data.Bifunctor (bimap, first)-import Data.Foldable (foldl', toList)-import Data.Functor (($>))-import qualified Data.List.NonEmpty as NE-import Data.Maybe (isJust, fromJust, mapMaybe)-import qualified Data.Text as Text-import qualified Language.PureScript.AST as AST-import qualified Language.PureScript.AST.SourcePos as Pos-import qualified Language.PureScript.Comments as C-import qualified Language.PureScript.Environment as Env-import qualified Language.PureScript.Kinds as K-import qualified Language.PureScript.Label as L-import qualified Language.PureScript.Names as N-import Language.PureScript.PSString (mkString)-import qualified Language.PureScript.Types as T-import Language.PureScript.CST.Positions-import Language.PureScript.CST.Types--comment :: Comment a -> Maybe C.Comment-comment = \case-  Comment t-    | Text.isPrefixOf "{-" t -> Just $ C.BlockComment $ Text.drop 2 $ Text.dropEnd 2 t-    | Text.isPrefixOf "--" t -> Just $ C.LineComment $ Text.drop 2 t-  _ -> Nothing--comments :: [Comment a] -> [C.Comment]-comments = mapMaybe comment--sourcePos :: SourcePos -> Pos.SourcePos-sourcePos (SourcePos line col) = Pos.SourcePos line col--sourceSpan :: String -> SourceRange -> Pos.SourceSpan-sourceSpan name (SourceRange start end) = Pos.SourceSpan name (sourcePos start) (sourcePos end)--widenLeft :: TokenAnn -> Pos.SourceAnn -> Pos.SourceAnn-widenLeft ann (sp, _) =-  ( Pos.widenSourceSpan (sourceSpan (Pos.spanName sp) $ tokRange ann) sp-  , comments $ tokLeadingComments ann-  )--sourceAnnCommented :: String -> SourceToken -> SourceToken -> Pos.SourceAnn-sourceAnnCommented fileName (SourceToken ann1 _) (SourceToken ann2 _) =-  ( Pos.SourceSpan fileName (sourcePos $ srcStart $ tokRange ann1) (sourcePos $ srcEnd $ tokRange ann2)-  , comments $ tokLeadingComments ann1-  )--sourceAnn :: String -> SourceToken -> SourceToken -> Pos.SourceAnn-sourceAnn fileName (SourceToken ann1 _) (SourceToken ann2 _) =-  ( Pos.SourceSpan fileName (sourcePos $ srcStart $ tokRange ann1) (sourcePos $ srcEnd $ tokRange ann2)-  , []-  )--sourceName :: String -> Name a -> Pos.SourceAnn-sourceName fileName a = sourceAnnCommented fileName (nameTok a) (nameTok a)--sourceQualName :: String -> QualifiedName a -> Pos.SourceAnn-sourceQualName fileName a = sourceAnnCommented fileName (qualTok a) (qualTok a)--moduleName :: Token -> Maybe N.ModuleName-moduleName = \case-  TokLowerName as _ -> go as-  TokUpperName as _ -> go as-  TokSymbolName as _ -> go as-  TokOperator as _ -> go as-  _ -> Nothing-  where-  go [] = Nothing-  go ns = Just $ N.ModuleName $ Text.intercalate "." ns--qualified :: QualifiedName a -> N.Qualified a-qualified q = N.Qualified (qualModule q) (qualName q)--ident :: Ident -> N.Ident-ident = N.Ident . getIdent--convertKind :: String -> Kind a -> K.SourceKind-convertKind fileName = go-  where-  go = \case-    KindName _ a ->-      K.NamedKind (sourceQualName fileName a) $ qualified a-    KindArr _ a _ b -> do-      let-        lhs = go a-        rhs = go b-        ann = Pos.widenSourceAnn (K.getAnnForKind lhs) (K.getAnnForKind rhs)-      K.FunKind ann lhs rhs-    KindRow _ tok a -> do-      let-        kind = go a-        ann = widenLeft (tokAnn tok) $ K.getAnnForKind kind-      K.Row ann kind-    KindParens _ (Wrapped _ a _) ->-      go a--convertType :: String -> Type a -> T.SourceType-convertType fileName = go-  where-  goRow (Row labels tl) b = do-    let-      rowTail = case tl of-        Just (_, ty) -> go ty-        Nothing -> T.REmpty $ sourceAnnCommented fileName b b-      rowCons (Labeled a _ ty) c = do-        let ann = sourceAnnCommented fileName (lblTok a) (snd $ typeRange ty)-        T.RCons ann (L.Label $ lblName a) (go ty) c-    case labels of-      Just (Separated h t) ->-        rowCons h $ foldr (rowCons . snd) rowTail t-      Nothing ->-        rowTail--  go = \case-    TypeVar _ a ->-      T.TypeVar (sourceName fileName a) . getIdent $ nameValue a-    TypeConstructor _ a ->-      T.TypeConstructor (sourceQualName fileName a) $ qualified a-    TypeWildcard _ a ->-      T.TypeWildcard (sourceAnnCommented fileName a a) Nothing-    TypeHole _ a ->-      T.TypeWildcard (sourceName fileName a) . Just . getIdent $ nameValue a-    TypeString _ a b ->-      T.TypeLevelString (sourceAnnCommented fileName a a) $ b-    TypeRow _ (Wrapped _ row b) ->-      goRow row b-    TypeRecord _ (Wrapped a row b) -> do-      let-        ann = sourceAnnCommented fileName a b-        annRec = sourceAnn fileName a a-      T.TypeApp ann (Env.tyRecord $> annRec) $ goRow row b-    TypeForall _ kw bindings _ ty -> do-      let-        mkForAll a b t = do-          let ann' = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType t-          T.ForAll ann' (getIdent $ nameValue a) b t Nothing-        k t (TypeVarKinded (Wrapped _ (Labeled a _ b) _)) = mkForAll a (Just (convertKind fileName b)) t-        k t (TypeVarName a) = mkForAll a Nothing t-        -- The existing parser builds variables in reverse order-        ty' = foldl k (go ty) bindings-        ann = widenLeft (tokAnn kw) $ T.getAnnForType ty'-      T.setAnnForType ann ty'-    TypeKinded _ ty _ kd -> do-      let-        ty' = go ty-        kd' = convertKind fileName kd-        ann = Pos.widenSourceAnn (T.getAnnForType ty') (K.getAnnForKind kd')-      T.KindedType ann ty' kd'-    TypeApp _ a b -> do-      let-        a' = go a-        b' = go b-        ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')-      T.TypeApp ann a' b'-    ty@(TypeOp _ _ _ _) -> do-      let-        reassoc op b' a = do-          let-            a'  = go a-            op' = T.TypeOp (sourceQualName fileName op) $ qualified op-            ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')-          T.BinaryNoParensType ann op' (go a) b'-        loop k = \case-          TypeOp _ a op b -> loop (reassoc op (k b)) a-          expr' -> k expr'-      loop go ty-    TypeOpName _ op -> do-      let rng = qualRange op-      T.TypeOp (uncurry (sourceAnnCommented fileName) rng) (qualified op)-    TypeArr _ a arr b -> do-      let-        a' = go a-        b' = go b-        arr' = Env.tyFunction $> sourceAnnCommented fileName arr arr-        ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')-      T.TypeApp ann (T.TypeApp ann arr' a') b'-    TypeArrName _ a ->-      Env.tyFunction $> sourceAnnCommented fileName a a-    TypeConstrained _ a _ b -> do-      let-        a' = convertConstraint fileName a-        b' = go b-        ann = Pos.widenSourceAnn (T.constraintAnn a') (T.getAnnForType b')-      T.ConstrainedType ann a' b'-    TypeParens _ (Wrapped a ty b) ->-      T.ParensInType (sourceAnnCommented fileName a b) $ go ty--convertConstraint :: String -> Constraint a -> T.SourceConstraint-convertConstraint fileName = go-  where-  go = \case-    cst@(Constraint _ name args) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ constraintRange cst-      T.Constraint ann (qualified name) (convertType fileName <$> args) Nothing-    ConstraintParens _ (Wrapped _ c _) -> go c--convertGuarded :: String -> Guarded a -> [AST.GuardedExpr]-convertGuarded fileName = \case-  Unconditional _ x -> [AST.GuardedExpr [] (convertWhere fileName x)]-  Guarded gs -> (\(GuardedExpr _ ps _ x) -> AST.GuardedExpr (p <$> toList ps) (convertWhere fileName x)) <$> NE.toList gs-  where-  go = convertExpr fileName-  p (PatternGuard Nothing x) = AST.ConditionGuard (go x)-  p (PatternGuard (Just (b, _)) x) = AST.PatternGuard (convertBinder fileName b) (go x)--convertWhere :: String -> Where a -> AST.Expr-convertWhere fileName = \case-  Where expr Nothing -> convertExpr fileName expr-  Where expr (Just (_, bs)) -> do-    let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-    uncurry AST.PositionedValue ann . AST.Let AST.FromWhere (convertLetBinding fileName <$> NE.toList bs) $ convertExpr fileName expr--convertLetBinding :: String -> LetBinding a -> AST.Declaration-convertLetBinding fileName = \case-  LetBindingSignature _ lbl ->-    convertSignature fileName lbl-  binding@(LetBindingName _ fields) -> do-    let ann = uncurry (sourceAnnCommented fileName) $ letBindingRange binding-    convertValueBindingFields fileName ann fields-  binding@(LetBindingPattern _ a _ b) -> do-    let ann = uncurry (sourceAnnCommented fileName) $ letBindingRange binding-    AST.BoundValueDeclaration ann (convertBinder fileName a) (convertWhere fileName b)--convertExpr :: forall a. String -> Expr a -> AST.Expr-convertExpr fileName = go-  where-  positioned =-    uncurry AST.PositionedValue--  goDoStatement = \case-    stmt@(DoLet _ as) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ doStatementRange stmt-      uncurry AST.PositionedDoNotationElement ann . AST.DoNotationLet $ convertLetBinding fileName <$> NE.toList as-    stmt@(DoDiscard a) -> do-      let ann = uncurry (sourceAnn fileName) $ doStatementRange stmt-      uncurry AST.PositionedDoNotationElement ann . AST.DoNotationValue $ go a-    stmt@(DoBind a _ b) -> do-      let-        ann = uncurry (sourceAnn fileName) $ doStatementRange stmt-        a' = convertBinder fileName a-        b' = go b-      uncurry AST.PositionedDoNotationElement ann $ AST.DoNotationBind a' b'--  go = \case-    ExprHole _ a ->-      positioned (sourceName fileName a) . AST.Hole . getIdent $ nameValue a-    ExprSection _ a ->-      positioned (sourceAnnCommented fileName a a) AST.AnonymousArgument-    ExprIdent _ a -> do-      let ann = sourceQualName fileName a-      positioned ann . AST.Var (fst ann) . qualified $ fmap ident a-    ExprConstructor _ a -> do-      let ann = sourceQualName fileName a-      positioned ann . AST.Constructor (fst ann) $ qualified a-    ExprBoolean _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.Literal (fst ann) $ AST.BooleanLiteral b-    ExprChar _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.Literal (fst ann) $ AST.CharLiteral b-    ExprString _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.Literal (fst ann) . AST.StringLiteral $ b-    ExprNumber _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.Literal (fst ann) $ AST.NumericLiteral b-    ExprArray _ (Wrapped a bs c) -> do-      let-        ann = sourceAnnCommented fileName a c-        vals = case bs of-          Just (Separated x xs) -> go x : (go . snd <$> xs)-          Nothing -> []-      positioned ann . AST.Literal (fst ann) $ AST.ArrayLiteral vals-    ExprRecord z (Wrapped a bs c) -> do-      let-        ann = sourceAnnCommented fileName a c-        lbl = \case-          RecordPun f -> (mkString . getIdent $ nameValue f, go . ExprIdent z $ QualifiedName (nameTok f) Nothing (nameValue f))-          RecordField f _ v -> (lblName f, go v)-        vals = case bs of-          Just (Separated x xs) -> lbl x : (lbl . snd <$> xs)-          Nothing -> []-      positioned ann . AST.Literal (fst ann) $ AST.ObjectLiteral vals-    ExprParens _ (Wrapped a b c) ->-      positioned (sourceAnnCommented fileName a c) . AST.Parens $ go b-    expr@(ExprTyped _ a _ b) -> do-      let-        a' = go a-        b' = convertType fileName b-        ann = (sourceSpan fileName . toSourceRange $ exprRange expr, [])-      positioned ann $ AST.TypedValue True a' b'-    expr@(ExprInfix _ a (Wrapped _ b _) c) -> do-      let ann = (sourceSpan fileName . toSourceRange $ exprRange expr, [])-      positioned ann $ AST.BinaryNoParens (go b) (go a) (go c)-    expr@(ExprOp _ _ _ _) -> do-      let-        ann = uncurry (sourceAnn fileName) $ exprRange expr-        reassoc op b a = do-          let op' = AST.Op (sourceSpan fileName . toSourceRange $ qualRange op) $ qualified op-          AST.BinaryNoParens op' (go a) b-        loop k = \case-          ExprOp _ a op b -> loop (reassoc op (k b)) a-          expr' -> k expr'-      positioned ann $ loop go expr-    ExprOpName _ op -> do-      let-        rng = qualRange op-        op' = AST.Op (sourceSpan fileName $ toSourceRange rng) $ qualified op-      positioned (uncurry (sourceAnnCommented fileName) rng) op'-    expr@(ExprNegate _ _ b) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-      positioned ann . AST.UnaryMinus (fst ann) $ go b-    expr@(ExprRecordAccessor _ (RecordAccessor a _ (Separated h t))) -> do-      let-        ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-        field x f = AST.Accessor (lblName f) x-      positioned ann $ foldl' (\x (_, f) -> field x f) (field (go a) h) t-    expr@(ExprRecordUpdate _ a b) -> do-      let-        ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-        k (RecordUpdateLeaf f _ x) = (lblName f, AST.Leaf $ go x)-        k (RecordUpdateBranch f xs) = (lblName f, AST.Branch $ toTree xs)-        toTree (Wrapped _ xs _) = AST.PathTree . AST.AssocList . map k $ toList xs-      positioned ann . AST.ObjectUpdateNested (go a) $ toTree b-    expr@(ExprApp _ a b) -> do-      let ann = uncurry (sourceAnn fileName) $ exprRange expr-      positioned ann $ AST.App (go a) (go b)-    expr@(ExprLambda _ (Lambda _ as _ b)) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-      positioned ann-        . AST.Abs (convertBinder fileName (NE.head as))-        . foldr (AST.Abs . convertBinder fileName) (go b)-        $ NE.tail as-    expr@(ExprIf _ (IfThenElse _ a _ b _ c)) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-      positioned ann $ AST.IfThenElse (go a) (go b) (go c)-    expr@(ExprCase _ (CaseOf _ as _ bs)) -> do-      let-        ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-        as' = go <$> toList as-        bs' = uncurry AST.CaseAlternative . bimap (map (convertBinder fileName) . toList) (convertGuarded fileName) <$> NE.toList bs-      positioned ann $ AST.Case as' bs'-    expr@(ExprLet _ (LetIn _ as _ b)) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-      positioned ann . AST.Let AST.FromLet (convertLetBinding fileName <$> NE.toList as) $ go b-    -- expr@(ExprWhere _ (Where a _ bs)) -> do-    --   let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-    --   positioned ann . AST.Let AST.FromWhere (goLetBinding <$> bs) $ go a-    expr@(ExprDo _ (DoBlock kw stmts)) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-      positioned ann . AST.Do (moduleName $ tokValue kw) $ goDoStatement <$> NE.toList stmts-    expr@(ExprAdo _ (AdoBlock kw stms _ a)) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr-      positioned ann . AST.Ado (moduleName $ tokValue kw) (goDoStatement <$> stms) $ go a--convertBinder :: String -> Binder a -> AST.Binder-convertBinder fileName = go-  where-  positioned =-    uncurry AST.PositionedBinder--  go = \case-    BinderWildcard _ a ->-      positioned (sourceAnnCommented fileName a a) AST.NullBinder-    BinderVar _ a -> do-      let ann = sourceName fileName a-      positioned ann . AST.VarBinder (fst ann) . ident $ nameValue a-    binder@(BinderNamed _ a _ b) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ binderRange binder-      positioned ann . AST.NamedBinder (fst ann) (ident $ nameValue a) $ go b-    binder@(BinderConstructor _ a bs) -> do-      let ann = uncurry (sourceAnnCommented fileName) $ binderRange binder-      positioned ann . AST.ConstructorBinder (fst ann) (qualified a) $ go <$> bs-    BinderBoolean _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.LiteralBinder (fst ann) $ AST.BooleanLiteral b-    BinderChar _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.LiteralBinder (fst ann) $ AST.CharLiteral b-    BinderString _ a b -> do-      let ann = sourceAnnCommented fileName a a-      positioned ann . AST.LiteralBinder (fst ann) . AST.StringLiteral $ b-    BinderNumber _ n a b -> do-      let-        ann = sourceAnnCommented fileName a a-        b'-          | isJust n = bimap negate negate b-          | otherwise = b-      positioned ann . AST.LiteralBinder (fst ann) $ AST.NumericLiteral b'-    BinderArray _ (Wrapped a bs c) -> do-      let-        ann = sourceAnnCommented fileName a c-        vals = case bs of-          Just (Separated x xs) -> go x : (go . snd <$> xs)-          Nothing -> []-      positioned ann . AST.LiteralBinder (fst ann) $ AST.ArrayLiteral vals-    BinderRecord z (Wrapped a bs c) -> do-      let-        ann = sourceAnnCommented fileName a c-        lbl = \case-          RecordPun f -> (mkString . getIdent $ nameValue f, go $ BinderVar z f)-          RecordField f _ v -> (lblName f, go v)-        vals = case bs of-          Just (Separated x xs) -> lbl x : (lbl . snd <$> xs)-          Nothing -> []-      positioned ann . AST.LiteralBinder (fst ann) $ AST.ObjectLiteral vals-    BinderParens _ (Wrapped a b c) ->-      positioned (sourceAnnCommented fileName a c) . AST.ParensInBinder $ go b-    binder@(BinderTyped _ a _ b) -> do-      let-        a' = go a-        b' = convertType fileName b-        ann = (sourceSpan fileName . toSourceRange $ binderRange binder, [])-      positioned ann $ AST.TypedBinder b' a'-    binder@(BinderOp _ _ _ _) -> do-      let-        ann = uncurry (sourceAnn fileName) $ binderRange binder-        reassoc op b a = do-          let op' = AST.OpBinder (sourceSpan fileName . toSourceRange $ qualRange op) $ qualified op-          AST.BinaryNoParensBinder op' (go a) b-        loop k = \case-          BinderOp _ a op b -> loop (reassoc op (k b)) a-          binder' -> k binder'-      positioned ann $ loop go binder--convertDeclaration :: String -> Declaration a -> [AST.Declaration]-convertDeclaration fileName decl = case decl of-  DeclData _ (DataHead _ a vars) bd -> do-    let-      ctrs :: SourceToken -> DataCtor a -> [(SourceToken, DataCtor a)] -> [AST.DataConstructorDeclaration]-      ctrs st (DataCtor _ name fields) tl-        = AST.DataConstructorDeclaration (sourceAnnCommented fileName st (nameTok name)) (nameValue name) (zip ctrFields $ convertType fileName <$> fields)-        : (case tl of-            [] -> []-            (st', ctor) : tl' -> ctrs st' ctor tl'-          )-    pure $ AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd tl) -> ctrs st hd tl) bd)-  DeclType _ (DataHead _ a vars) _ bd ->-    pure $ AST.TypeSynonymDeclaration ann-      (nameValue a)-      (goTypeVar <$> vars)-      (convertType fileName bd)-  DeclNewtype _ (DataHead _ a vars) st x ys -> do-    let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(head ctrFields, convertType fileName ys)]]-    pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs-  DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do-    let-      goTyVar (TypeVarKinded (Wrapped _ (Labeled a _ _) _)) = nameValue a-      goTyVar (TypeVarName a) = nameValue a-      vars' = zip (toList $ goTyVar <$> vars) [0..]-      goName = fromJust . flip lookup vars' . nameValue-      goFundep (FundepDetermined _ bs) = Env.FunctionalDependency [] (goName <$> NE.toList bs)-      goFundep (FundepDetermines as _ bs) = Env.FunctionalDependency (goName <$> NE.toList as) (goName <$> NE.toList bs)-      goSig (Labeled n _ ty) = do-        let-          ty' = convertType fileName ty-          ann' = widenLeft (tokAnn $ nameTok n) $ T.getAnnForType ty'-        AST.TypeDeclaration $ AST.TypeDeclarationData ann' (ident $ nameValue n) ty'-    pure $ AST.TypeClassDeclaration ann-      (nameValue name)-      (goTypeVar <$> vars)-      (convertConstraint fileName <$> maybe [] (toList . fst) sup)-      (goFundep <$> maybe [] (toList . snd) fdeps)-      (goSig <$> maybe [] (NE.toList . snd) bd)-  DeclInstanceChain _ insts -> do-    let-      instName (Instance (InstanceHead _ a _ _ _ _) _) = ident $ nameValue a-      chainId = instName <$> toList insts-      goInst ix inst@(Instance (InstanceHead _ name _ ctrs cls args) bd) = do-        let ann' = uncurry (sourceAnnCommented fileName) $ instanceRange inst-        AST.TypeInstanceDeclaration ann' chainId ix-          (ident $ nameValue name)-          (convertConstraint fileName <$> maybe [] (toList . fst) ctrs)-          (qualified cls)-          (convertType fileName <$> args)-          (AST.ExplicitInstance $ goInstanceBinding <$> maybe [] (NE.toList . snd) bd)-    uncurry goInst <$> zip [0..] (toList insts)-  DeclDerive _ _ new (InstanceHead _ name _ ctrs cls args) -> do-    let-      name' = ident $ nameValue name-      instTy-        | isJust new = AST.NewtypeInstance-        | otherwise = AST.DerivedInstance-    pure $ AST.TypeInstanceDeclaration ann [name'] 0 name'-      (convertConstraint fileName <$> maybe [] (toList . fst) ctrs)-      (qualified cls)-      (convertType fileName <$> args)-      instTy-  DeclSignature _ lbl ->-    pure $ convertSignature fileName lbl-  DeclValue _ fields ->-    pure $ convertValueBindingFields fileName ann fields-  DeclFixity _ (FixityFields (_, kw) (_, prec) fxop) -> do-    let-      assoc =  case kw of-        Infix  -> AST.Infix-        Infixr -> AST.Infixr-        Infixl -> AST.Infixl-      fixity = AST.Fixity assoc prec-    pure $ AST.FixityDeclaration ann $ case fxop of-      FixityValue name _ op -> do-        Left $ AST.ValueFixity fixity (first ident <$> qualified name) (nameValue op)-      FixityType _ name _ op ->-        Right $ AST.TypeFixity fixity (qualified name) (nameValue op)-  DeclForeign _ _ _ frn ->-    pure $ case frn of-      ForeignValue (Labeled a _ b) ->-        AST.ExternDeclaration ann (ident $ nameValue a) $ convertType fileName b-      ForeignData _ (Labeled a _ b) ->-        AST.ExternDataDeclaration ann (nameValue a) $ convertKind fileName b-      ForeignKind _ a ->-        AST.ExternKindDeclaration ann (nameValue a)-  where-  ann =-    uncurry (sourceAnnCommented fileName) $ declRange decl--  goTypeVar = \case-    TypeVarKinded (Wrapped _ (Labeled x _ y) _) -> (getIdent $ nameValue x, Just $ convertKind fileName y)-    TypeVarName x -> (getIdent $ nameValue x, Nothing)--  goInstanceBinding = \case-    InstanceBindingSignature _ lbl ->-      convertSignature fileName lbl-    binding@(InstanceBindingName _ fields) -> do-      let ann' = uncurry (sourceAnnCommented fileName) $ instanceBindingRange binding-      convertValueBindingFields fileName ann' fields--convertSignature :: String -> Labeled (Name Ident) (Type a) -> AST.Declaration-convertSignature fileName (Labeled a _ b) = do-  let-    b' = convertType fileName b-    ann = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType b'-  AST.TypeDeclaration $ AST.TypeDeclarationData ann (ident $ nameValue a) b'--convertValueBindingFields :: String -> Pos.SourceAnn -> ValueBindingFields a -> AST.Declaration-convertValueBindingFields fileName ann (ValueBindingFields a bs c) = do-  let-    bs' = convertBinder fileName <$> bs-    cs' = convertGuarded fileName c-  AST.ValueDeclaration $ AST.ValueDeclarationData ann (ident $ nameValue a) Env.Public bs' cs'--convertImportDecl-  :: String-  -> ImportDecl a-  -> (Pos.SourceAnn, N.ModuleName, AST.ImportDeclarationType, Maybe N.ModuleName)-convertImportDecl fileName decl@(ImportDecl _ _ modName mbNames mbQual) = do-  let-    ann = uncurry (sourceAnnCommented fileName) $ importDeclRange decl-    importTy = case mbNames of-      Nothing -> AST.Implicit-      Just (hiding, (Wrapped _ imps _)) -> do-        let imps' = convertImport fileName <$> toList imps-        if isJust hiding-          then AST.Hiding imps'-          else AST.Explicit imps'-  (ann, nameValue modName, importTy, nameValue . snd <$> mbQual)--convertImport :: String -> Import a -> AST.DeclarationRef-convertImport fileName imp = case imp of-  ImportValue _ a ->-    AST.ValueRef ann . ident $ nameValue a-  ImportOp _ a ->-    AST.ValueOpRef ann $ nameValue a-  ImportType _ a mb -> do-    let-      ctrs = case mb of-        Nothing -> Just []-        Just (DataAll _ _) -> Nothing-        Just (DataEnumerated _ (Wrapped _ Nothing _)) -> Just []-        Just (DataEnumerated _ (Wrapped _ (Just idents) _)) ->-          Just . map nameValue $ toList idents-    AST.TypeRef ann (nameValue a) ctrs-  ImportTypeOp _ _ a ->-    AST.TypeOpRef ann $ nameValue a-  ImportClass _ _ a ->-    AST.TypeClassRef ann $ nameValue a-  ImportKind _ _ a ->-    AST.KindRef ann $ nameValue a-  where-  ann = sourceSpan fileName . toSourceRange $ importRange imp--convertExport :: String -> Export a -> AST.DeclarationRef-convertExport fileName export = case export of-  ExportValue _ a ->-    AST.ValueRef ann . ident $ nameValue a-  ExportOp _ a ->-    AST.ValueOpRef ann $ nameValue a-  ExportType _ a mb -> do-    let-      ctrs = case mb of-        Nothing -> Just []-        Just (DataAll _ _) -> Nothing-        Just (DataEnumerated _ (Wrapped _ Nothing _)) -> Just []-        Just (DataEnumerated _ (Wrapped _ (Just idents) _)) ->-          Just . map nameValue $ toList idents-    AST.TypeRef ann (nameValue a) ctrs-  ExportTypeOp _ _ a ->-    AST.TypeOpRef ann $ nameValue a-  ExportClass _ _ a ->-    AST.TypeClassRef ann $ nameValue a-  ExportKind _ _ a ->-    AST.KindRef ann $ nameValue a-  ExportModule _ _ a ->-    AST.ModuleRef ann (nameValue a)-  where-  ann = sourceSpan fileName . toSourceRange $ exportRange export--convertModule :: String -> Module a -> AST.Module-convertModule fileName module'@(Module _ _ modName exps _ imps decls _) = do-  let-    ann = uncurry (sourceAnnCommented fileName) $ moduleRange module'-    imps' = importCtr. convertImportDecl fileName <$> imps-    decls' = convertDeclaration fileName =<< decls-    exps' = map (convertExport fileName) . toList . wrpValue <$> exps-  uncurry AST.Module ann (nameValue modName) (imps' <> decls') exps'-  where-  importCtr (a, b, c, d) = AST.ImportDeclaration a b c d--ctrFields :: [N.Ident]-ctrFields = [N.Ident ("value" <> Text.pack (show (n :: Integer))) | n <- [0..]]
− src/Language/PureScript/CST/Errors.hs 
@@ -1,165 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-module Language.PureScript.CST.Errors-  ( ParserError(..)-  , ParserErrorType(..)-  , prettyPrintError-  , prettyPrintErrorMessage-  ) where--import Prelude--import qualified Data.Text as Text-import Data.Char (isSpace, toUpper)-import Language.PureScript.CST.Layout-import Language.PureScript.CST.Print-import Language.PureScript.CST.Types-import Text.Printf (printf)--data ParserErrorType-  = ErrWildcardInType-  | ErrHoleInType-  | ErrExprInBinder-  | ErrExprInDeclOrBinder-  | ErrExprInDecl-  | ErrBinderInDecl-  | ErrRecordUpdateInCtr-  | ErrRecordPunInUpdate-  | ErrRecordCtrInUpdate-  | ErrTypeInConstraint-  | ErrElseInDecl-  | ErrInstanceNameMismatch-  | ErrUnknownFundep-  | ErrImportInDecl-  | ErrGuardInLetBinder-  | ErrKeywordVar-  | ErrKeywordSymbol-  | ErrQuotedPun-  | ErrToken-  | ErrLineFeedInString-  | ErrAstralCodePointInChar-  | ErrCharEscape-  | ErrNumberOutOfRange-  | ErrLeadingZero-  | ErrExpectedFraction-  | ErrExpectedExponent-  | ErrExpectedHex-  | ErrReservedSymbol-  | ErrCharInGap Char-  | ErrModuleName-  | ErrQualifiedName-  | ErrEmptyDo-  | ErrLexeme (Maybe String) [String]-  | ErrEof-  | ErrCustom String-  deriving (Show, Eq, Ord)--data ParserError = ParserError-  { errRange :: SourceRange-  , errToks :: [SourceToken]-  , errStack :: LayoutStack-  , errType :: ParserErrorType-  } deriving (Show, Eq)--prettyPrintError :: ParserError -> String-prettyPrintError pe@(ParserError { errRange }) =-  prettyPrintErrorMessage pe <> " at " <> errPos-  where-  errPos = case errRange of-    SourceRange (SourcePos line col) _ ->-      "line " <> show line <> ", column " <> show col--prettyPrintErrorMessage :: ParserError -> String-prettyPrintErrorMessage (ParserError {..}) = case errType of-  ErrWildcardInType ->-    "Unexpected wildcard in type; type wildcards are only allowed in value annotations"-  ErrHoleInType ->-    "Unexpected hole in type; type holes are only allowed in value annotations"-  ErrExprInBinder ->-    "Expected pattern, saw expression"-  ErrExprInDeclOrBinder ->-    "Expected declaration or pattern, saw expression"-  ErrExprInDecl ->-    "Expected declaration, saw expression"-  ErrBinderInDecl ->-    "Expected declaration, saw pattern"-  ErrRecordUpdateInCtr ->-    "Expected ':', saw '='"-  ErrRecordPunInUpdate ->-    "Expected record update, saw pun"-  ErrRecordCtrInUpdate ->-    "Expected '=', saw ':'"-  ErrTypeInConstraint ->-    "Expected constraint, saw type"-  ErrElseInDecl ->-    "Expected declaration, saw 'else'"-  ErrInstanceNameMismatch ->-    "All instances in a chain must implement the same type class"-  ErrUnknownFundep ->-    "Unknown type variable in functional dependency"-  ErrImportInDecl ->-    "Expected declaration, saw 'import'"-  ErrGuardInLetBinder ->-    "Unexpected guard in let pattern"-  ErrKeywordVar ->-    "Expected variable, saw keyword"-  ErrKeywordSymbol ->-    "Expected symbol, saw reserved symbol"-  ErrQuotedPun ->-    "Unexpected quoted label in record pun, perhaps due to a missing ':'"-  ErrEof ->-    "Unexpected end of input"-  ErrLexeme (Just (hd : _)) _ | isSpace hd ->-    "Illegal whitespace character " <> displayCodePoint hd-  ErrLexeme (Just a) _ ->-    "Unexpected " <> a-  ErrLineFeedInString ->-    "Unexpected line feed in string literal"-  ErrAstralCodePointInChar ->-    "Illegal astral code point in character literal"-  ErrCharEscape ->-    "Illegal character escape code"-  ErrNumberOutOfRange ->-    "Number literal is out of range"-  ErrLeadingZero ->-    "Unexpected leading zeros"-  ErrExpectedFraction ->-    "Expected fraction"-  ErrExpectedExponent ->-    "Expected exponent"-  ErrExpectedHex ->-    "Expected hex digit"-  ErrReservedSymbol ->-    "Unexpected reserved symbol"-  ErrCharInGap ch ->-    "Unexpected character '" <> [ch] <> "' in gap"-  ErrModuleName ->-    "Invalid module name; underscores and primes are not allowed in module names"-  ErrQualifiedName ->-    "Unexpected qualified name"-  ErrEmptyDo ->-    "Expected do statement"-  ErrLexeme _ _ ->-    basicError-  ErrToken-    | SourceToken _ (TokLeftArrow _) : _ <- errToks ->-        "Unexpected \"<-\" in expression, perhaps due to a missing 'do' or 'ado' keyword"-  ErrToken ->-    basicError-  ErrCustom err ->-    err--  where-  basicError = case errToks of-    tok : _ -> basicTokError (tokValue tok)-    [] -> "Unexpected input"--  basicTokError = \case-    TokLayoutStart -> "Unexpected or mismatched indentation"-    TokLayoutSep   -> "Unexpected or mismatched indentation"-    TokLayoutEnd   -> "Unexpected or mismatched indentation"-    TokEof         -> "Unexpected end of input"-    tok            -> "Unexpected token '" <> Text.unpack (printToken tok) <> "'"--  displayCodePoint :: Char -> String-  displayCodePoint x =-    "U+" <> map toUpper (printf "%0.4x" (fromEnum x))
− src/Language/PureScript/CST/Layout.hs 
@@ -1,401 +0,0 @@--- | The parser itself is unaware of indentation, and instead only parses explicit--- delimiters which are inserted by this layout algorithm (much like Haskell).--- This is convenient because the actual grammar can be specified apart from the--- indentation rules. Haskell has a few problematic productions which make it--- impossible to implement a purely lexical layout algorithm, so it also has an--- additional (and somewhat contentious) parser error side condition. PureScript--- does not have these problematic productions (particularly foo, bar ::--- SomeType syntax in declarations), but it does have a few gotchas of it's own.--- The algorithm is "non-trivial" to say the least, but it is implemented as a--- purely lexical delimiter parser on a token-by-token basis, which is highly--- convenient, since it can be replicated in any language or toolchain. There is--- likely room to simplify it, but there are some seemingly innocuous things--- that complicate it.------ "Naked" commas (case, patterns, guards, fundeps) are a constant source of--- complexity, and indeed too much of this is what prevents Haskell from having--- such an algorithm. Unquoted properties for layout keywords introduce a domino--- effect of complexity since we have to mask and unmask any usage of . (also in--- foralls!) or labels in record literals.--module Language.PureScript.CST.Layout where--import Prelude--import Data.DList (snoc)-import qualified Data.DList as DList-import Data.Foldable (find)-import Data.Function ((&))-import Language.PureScript.CST.Types--type LayoutStack = [(SourcePos, LayoutDelim)]--data LayoutDelim-  = LytRoot-  | LytTopDecl-  | LytTopDeclHead-  | LytDeclGuard-  | LytCase-  | LytCaseBinders-  | LytCaseGuard-  | LytLambdaBinders-  | LytParen-  | LytBrace-  | LytSquare-  | LytIf-  | LytThen-  | LytProperty-  | LytForall-  | LytTick-  | LytLet-  | LytLetStmt-  | LytWhere-  | LytOf-  | LytDo-  | LytAdo-  deriving (Show, Eq, Ord)--isIndented :: LayoutDelim -> Bool-isIndented = \case-  LytLet     -> True-  LytLetStmt -> True-  LytWhere   -> True-  LytOf      -> True-  LytDo      -> True-  LytAdo     -> True-  _          -> False--isTopDecl :: SourcePos -> LayoutStack -> Bool-isTopDecl tokPos = \case-  [(lytPos, LytWhere), (_, LytRoot)]-    | srcColumn tokPos == srcColumn lytPos -> True-  _ -> False--lytToken :: SourcePos -> Token -> SourceToken-lytToken pos = SourceToken ann-  where-  ann = TokenAnn-    { tokRange = SourceRange pos pos-    , tokLeadingComments = []-    , tokTrailingComments = []-    }--insertLayout :: SourceToken -> SourcePos -> LayoutStack -> (LayoutStack, [SourceToken])-insertLayout src@(SourceToken tokAnn tok) nextPos stack =-  DList.toList <$> insert (stack, mempty)-  where-  tokPos =-    srcStart $ tokRange tokAnn--  insert state@(stk, acc) = case tok of-    -- `data` declarations need masking (LytTopDecl) because the usage of `|`-    -- should not introduce a LytDeclGard context.-    TokLowerName [] "data" ->-      case state & insertDefault of-        state'@(stk', _) | isTopDecl tokPos stk' ->-          state' & pushStack tokPos LytTopDecl-        state' ->-          state' & popStack (== LytProperty)--    -- `class` declaration heads need masking (LytTopDeclHead) because the-    -- usage of commas in functional dependencies.-    TokLowerName [] "class" ->-      case state & insertDefault of-        state'@(stk', _) | isTopDecl tokPos stk' ->-          state' & pushStack tokPos LytTopDeclHead-        state' ->-          state' & popStack (== LytProperty)--    TokLowerName [] "where" ->-      case stk of-        (_, LytTopDeclHead) : stk' ->-          (stk', acc) & insertToken src & insertStart LytWhere-        (_, LytProperty) : stk' ->-          (stk', acc) & insertToken src-        _ ->-          state & collapse whereP & insertToken src & insertStart LytWhere-      where-      -- `where` always closes do blocks:-      --     example = do do do do foo where foo = ...-      ---      -- `where` closes layout contexts even when indented at the same level:-      --     example = case-      --       Foo -> ...-      --       Bar -> ...-      --       where foo = ...-      whereP _      LytDo = True-      whereP lytPos lyt   = offsideEndP lytPos lyt--    TokLowerName [] "in" ->-      case collapse inP state of-        -- `let/in` is not allowed in `ado` syntax. `in` is treated as a-        -- delimiter and must always close the `ado`.-        --    example = ado-        --      foo <- ...-        --      let bar = ...-        --      in ...-        ((_, LytLetStmt) : (_, LytAdo) : stk', acc') ->-          (stk', acc') & insertEnd & insertEnd & insertToken src-        ((_, lyt) : stk', acc') | isIndented lyt ->-          (stk', acc') & insertEnd & insertToken src-        _ ->-          state & insertDefault & popStack (== LytProperty)-      where-      inP _ LytLet = False-      inP _ LytAdo = False-      inP _ lyt    = isIndented lyt--    TokLowerName [] "let" ->-      state & insertKwProperty next-      where-      next state'@(stk', _) = case stk' of-        (p, LytDo) : _ | srcColumn p == srcColumn tokPos ->-          state' & insertStart LytLetStmt-        (p, LytAdo) : _ | srcColumn p == srcColumn tokPos ->-          state' & insertStart LytLetStmt-        _ ->-          state' & insertStart LytLet--    TokLowerName _ "do" ->-      state & insertKwProperty (insertStart LytDo)--    TokLowerName _ "ado" ->-      state & insertKwProperty (insertStart LytAdo)--    -- `case` heads need masking due to commas.-    TokLowerName [] "case" ->-      state & insertKwProperty (pushStack tokPos LytCase)--    TokLowerName [] "of" ->-      case collapse indentedP state of-        -- When `of` is matched with a `case`, we are in a case block, and we-        -- need to mask additional contexts (LytCaseBinders, LytCaseGuards)-        -- due to commas.-        ((_, LytCase) : stk', acc') ->-          (stk', acc') & insertToken src & insertStart LytOf & pushStack nextPos LytCaseBinders-        state' ->-          state' & insertDefault & popStack (== LytProperty)--    -- `if/then/else` is considered a delimiter context. This allows us to-    -- write chained expressions in `do` blocks without stair-stepping:-    --     example = do-    --       foo-    --       if ... then-    --         ...-    --       else if ... then-    --         ...-    --       else-    --         ...-    TokLowerName [] "if" ->-      state & insertKwProperty (pushStack tokPos LytIf)--    TokLowerName [] "then" ->-      case state & collapse indentedP of-        ((_, LytIf) : stk', acc') ->-          (stk', acc') & insertToken src & pushStack tokPos LytThen-        _ ->-          state & insertDefault & popStack (== LytProperty)--    TokLowerName [] "else" ->-      case state & collapse indentedP of-        ((_, LytThen) : stk', acc') ->-          (stk', acc') & insertToken src-        _ ->-          -- We don't want to insert a layout separator for top-level `else` in-          -- instance chains.-          case state & collapse offsideP of-            state'@(stk', _) | isTopDecl tokPos stk' ->-              state' & insertToken src-            state' ->-              state' & insertSep & insertToken src & popStack (== LytProperty)--    -- `forall` binders need masking because the usage of `.` should not-    -- introduce a LytProperty context.-    TokForall _ ->-      state & insertKwProperty (pushStack tokPos LytForall)--    -- Lambdas need masking because the usage of `->` should not close a-    -- LytDeclGaurd or LytCaseGuard context.-    TokBackslash ->-      state & insertDefault & pushStack tokPos LytLambdaBinders--    TokRightArrow _ ->-      state & collapse arrowP & popStack guardP & insertToken src-      where-      arrowP _      LytDo     = True-      arrowP _      LytOf     = False-      arrowP lytPos lyt       = offsideEndP lytPos lyt--      guardP LytCaseBinders   = True-      guardP LytCaseGuard     = True-      guardP LytLambdaBinders = True-      guardP _                = False--    TokEquals ->-      case state & collapse equalsP of-        ((_, LytDeclGuard) : stk', acc') ->-          (stk', acc') & insertToken src-        _ ->-          state & insertDefault-      where-      equalsP _ LytWhere   = True-      equalsP _ LytLet     = True-      equalsP _ LytLetStmt = True-      equalsP _ _          = False--    -- Guards need masking because of commas.-    TokPipe ->-      case collapse offsideEndP state of-        state'@((_, LytOf) : _, _) ->-          state' & pushStack tokPos LytCaseGuard & insertToken src-        state'@((_, LytLet) : _, _) ->-          state' & pushStack tokPos LytDeclGuard & insertToken src-        state'@((_, LytLetStmt) : _, _) ->-          state' & pushStack tokPos LytDeclGuard & insertToken src-        state'@((_, LytWhere) : _, _) ->-          state' & pushStack tokPos LytDeclGuard & insertToken src-        _ ->-          state & insertDefault--    -- Ticks can either start or end an infix expression. We preemptively-    -- collapse all indentation contexts in search of a starting delimiter,-    -- and backtrack if we don't find one.-    TokTick ->-      case state & collapse indentedP of-        ((_, LytTick) : stk', acc') ->-          (stk', acc') & insertToken src-        _ ->-          state & insertDefault & pushStack tokPos LytTick--    -- In gneral, commas should close all indented contexts.-    --     example = [ do foo-    --                    bar, baz ]-    TokComma ->-      case state & collapse indentedP of-        -- If we see a LytBrace, then we are in a record type or literal.-        -- Record labels need masking so we can use unquoted keywords as labels-        -- without accidentally littering layout delimiters.-        state'@((_, LytBrace) : _, _) ->-          state' & insertToken src & pushStack tokPos LytProperty-        state' ->-          state' & insertToken src--    -- TokDot tokens usually entail property access, which need masking so we-    -- can use unquoted keywords as labels.-    TokDot ->-      case state & insertDefault of-        ((_, LytForall) : stk', acc') ->-          (stk', acc')-        state' ->-          state' & pushStack tokPos LytProperty--    TokLeftParen ->-      state & insertDefault & pushStack tokPos LytParen--    TokLeftBrace ->-      state & insertDefault & pushStack tokPos LytBrace & pushStack tokPos LytProperty--    TokLeftSquare ->-      state & insertDefault & pushStack tokPos LytSquare--    TokRightParen ->-      state & collapse indentedP & popStack (== LytParen) & insertToken src--    TokRightBrace ->-      state & collapse indentedP & popStack (== LytProperty) & popStack (== LytBrace) & insertToken src--    TokRightSquare ->-      state & collapse indentedP & popStack (== LytSquare) & insertToken src--    TokString _ _ ->-      state & insertDefault & popStack (== LytProperty)--    TokLowerName [] _ ->-      state & insertDefault & popStack (== LytProperty)--    TokOperator _ _ ->-      state & collapse offsideEndP & insertSep & insertToken src--    _ ->-      state & insertDefault--  insertDefault state =-    state & collapse offsideP & insertSep & insertToken src--  insertStart lyt state@(stk, _) =-    -- We only insert a new layout start when it's going to increase indentation.-    -- This prevents things like the following from parsing:-    --     instance foo :: Foo where-    --     foo = 42-    case find (isIndented . snd) stk of-      Just (pos, _) | srcColumn nextPos <= srcColumn pos -> state-      _ -> state & pushStack nextPos lyt & insertToken (lytToken nextPos TokLayoutStart)--  insertSep state@(stk, acc) = case stk of-    -- LytTopDecl is closed by a separator.-    (lytPos, LytTopDecl) : stk' | sepP lytPos ->-      (stk', acc) & insertToken sepTok-    -- LytTopDeclHead can be closed by a separator if there is no `where`.-    (lytPos, LytTopDeclHead) : stk' | sepP lytPos ->-      (stk', acc) & insertToken sepTok-    (lytPos, lyt) : _ | indentSepP lytPos lyt ->-      case lyt of-        -- If a separator is inserted in a case block, we need to push an-        -- additional LytCaseBinders context for comma masking.-        LytOf -> state & insertToken sepTok & pushStack tokPos LytCaseBinders-        _     -> state & insertToken sepTok-    _ -> state-    where-    sepTok = lytToken tokPos TokLayoutSep--  insertKwProperty k state =-    case state & insertDefault of-      ((_, LytProperty) : stk', acc') ->-        (stk', acc')-      state' ->-        k state'--  insertEnd =-    insertToken (lytToken tokPos TokLayoutEnd)--  insertToken token (stk, acc) =-    (stk, acc `snoc` token)--  pushStack lytPos lyt (stk, acc) =-    ((lytPos, lyt) : stk, acc)--  popStack p ((_, lyt) : stk', acc)-    | p lyt = (stk', acc)-  popStack _ state = state--  collapse p = uncurry go-    where-    go ((lytPos, lyt) : stk) acc-      | p lytPos lyt =-          go stk $ if isIndented lyt-                   then acc `snoc` lytToken tokPos TokLayoutEnd-                   else acc-    go stk acc = (stk, acc)--  indentedP =-    const isIndented--  offsideP lytPos lyt =-    isIndented lyt && srcColumn tokPos < srcColumn lytPos--  offsideEndP lytPos lyt =-    isIndented lyt && srcColumn tokPos <= srcColumn lytPos--  indentSepP lytPos lyt =-    isIndented lyt && sepP lytPos--  sepP lytPos =-    srcColumn tokPos == srcColumn lytPos && srcLine tokPos /= srcLine lytPos--unwindLayout :: SourcePos -> [Comment LineFeed] -> LayoutStack -> [SourceToken]-unwindLayout pos leading = go-  where-  go [] = []-  go ((_, LytRoot) : _) = [SourceToken (TokenAnn (SourceRange pos pos) leading []) TokEof]-  go ((_, lyt) : stk) | isIndented lyt = lytToken pos TokLayoutEnd : go stk-  go (_ : stk) = go stk
− src/Language/PureScript/CST/Lexer.hs 
@@ -1,712 +0,0 @@-{-# LANGUAGE BangPatterns #-}-module Language.PureScript.CST.Lexer-  ( lenient-  , lex-  , lexTopLevel-  , lexWithState-  , isUnquotedKey-  ) where--import Prelude hiding (lex, exp, exponent, lines)--import Control.Monad (join)-import qualified Data.Char as Char-import qualified Data.DList as DList-import Data.Foldable (foldl')-import Data.Functor (($>))-import qualified Data.Scientific as Sci-import Data.String (fromString)-import Data.Text (Text)-import qualified Data.Text as Text-import Language.PureScript.CST.Errors-import Language.PureScript.CST.Monad hiding (token)-import Language.PureScript.CST.Layout-import Language.PureScript.CST.Positions-import Language.PureScript.CST.Types---- | Stops at the first lexing error and replaces it with TokEof. Otherwise,--- the parser will fail when it attempts to draw a lookahead token.-lenient :: [LexResult] -> [LexResult]-lenient = go-  where-  go [] = []-  go (Right a : as) = Right a : go as-  go (Left (st, _) : _) = do-    let-      pos = lexPos st-      ann = TokenAnn (SourceRange pos pos) (lexLeading st) []-    [Right (SourceToken ann TokEof)]---- | Lexes according to root layout rules.-lex :: Text -> [LexResult]-lex src = do-  let (leading, src') = comments src-  lexWithState $ LexState-    { lexPos = advanceLeading (SourcePos 1 1) leading-    , lexLeading = leading-    , lexSource = src'-    , lexStack = [(SourcePos 0 0, LytRoot)]-    }---- | Lexes according to top-level declaration context rules.-lexTopLevel :: Text -> [LexResult]-lexTopLevel src = do-  let-    (leading, src') = comments src-    lexPos = advanceLeading (SourcePos 1 1) leading-    hd = Right $ lytToken lexPos TokLayoutStart-    tl = lexWithState $ LexState-      { lexPos = lexPos-      , lexLeading = leading-      , lexSource = src'-      , lexStack = [(lexPos, LytWhere), (SourcePos 0 0, LytRoot)]-      }-  hd : tl---- | Lexes according to some LexState.-lexWithState :: LexState -> [LexResult]-lexWithState = go-  where-  Parser lexK =-    tokenAndComments--  go state@(LexState {..}) =-    lexK lexSource onError onSuccess-    where-    onError lexSource' err = do-      let-        len1 = Text.length lexSource-        len2 = Text.length lexSource'-        chunk = Text.take (max 0 (len1 - len2)) lexSource-        chunkDelta = textDelta chunk-        pos = applyDelta lexPos chunkDelta-      pure $ Left-        ( state { lexSource = lexSource' }-        , ParserError (SourceRange pos $ applyDelta pos (0, 1)) [] lexStack err-        )--    onSuccess _ (TokEof, _) =-      Right <$> unwindLayout lexPos lexLeading lexStack-    onSuccess lexSource' (tok, (trailing, lexLeading')) = do-      let-        endPos = advanceToken lexPos tok-        lexPos' = advanceLeading (advanceTrailing endPos trailing) lexLeading'-        tokenAnn = TokenAnn-          { tokRange = SourceRange lexPos endPos-          , tokLeadingComments = lexLeading-          , tokTrailingComments = trailing-          }-        (lexStack', toks) =-          insertLayout (SourceToken tokenAnn tok) lexPos' lexStack-        state' = LexState-          { lexPos = lexPos'-          , lexLeading = lexLeading'-          , lexSource = lexSource'-          , lexStack = lexStack'-          }-      go2 state' toks--  go2 state [] = go state-  go2 state (t : ts) = Right t : go2 state ts--type Lexer = ParserM ParserErrorType Text--{-# INLINE next #-}-next :: Lexer ()-next = Parser $ \inp _ ksucc ->-  ksucc (Text.drop 1 inp) ()--{-# INLINE nextWhile #-}-nextWhile :: (Char -> Bool) -> Lexer Text-nextWhile p = Parser $ \inp _ ksucc -> do-  let (chs, inp') = Text.span p inp-  ksucc inp' chs--{-# INLINE peek #-}-peek :: Lexer (Maybe Char)-peek = Parser $ \inp _ ksucc ->-  if Text.null inp-    then ksucc inp Nothing-    else ksucc inp $ Just $ Text.head inp--{-# INLINE restore #-}-restore :: (ParserErrorType -> Bool) -> Lexer a -> Lexer a-restore p (Parser k) = Parser $ \inp kerr ksucc ->-  k inp (\inp' err -> kerr (if p err then inp else inp') err) ksucc--tokenAndComments :: Lexer (Token, ([Comment void], [Comment LineFeed]))-tokenAndComments = (,) <$> token <*> breakComments--comments :: Text -> ([Comment LineFeed], Text)-comments = \src -> k src (\_ _ -> ([], src)) (\inp (a, b) -> (a <> b, inp))-  where-  Parser k = breakComments--breakComments :: Lexer ([Comment void], [Comment LineFeed])-breakComments = k0 []-  where-  k0 acc = do-    spaces <- nextWhile (== ' ')-    lines  <- nextWhile isLineFeed-    let-      acc'-        | Text.null spaces = acc-        | otherwise = Space (Text.length spaces) : acc-    if Text.null lines-      then do-        mbComm <- comment-        case mbComm of-          Just comm -> k0 (comm : acc')-          Nothing   -> pure (reverse acc', [])-      else-        k1 acc' (goWs [] $ Text.unpack lines)--  k1 trl acc = do-    ws <- nextWhile (\c -> c == ' ' || isLineFeed c)-    let acc' = goWs acc $ Text.unpack ws-    mbComm <- comment-    case mbComm of-      Just comm -> k1 trl (comm : acc')-      Nothing   -> pure (reverse trl, reverse acc')--  goWs a ('\r' : '\n' : ls) = goWs (Line CRLF : a) ls-  goWs a ('\r' : ls) = goWs (Line CRLF : a) ls-  goWs a ('\n' : ls) = goWs (Line LF : a) ls-  goWs a (' ' : ls) = goSpace a 1 ls-  goWs a _ = a--  goSpace a !n (' ' : ls) = goSpace a (n + 1) ls-  goSpace a !n ls = goWs (Space n : a) ls--  isBlockComment = Parser $ \inp _ ksucc ->-    case Text.uncons inp of-      Just ('-', inp2) ->-        case Text.uncons inp2 of-          Just ('-', inp3) ->-            ksucc inp3 $ Just False-          _ ->-            ksucc inp Nothing-      Just ('{', inp2) ->-        case Text.uncons inp2 of-          Just ('-', inp3) ->-            ksucc inp3 $ Just True-          _ ->-            ksucc inp Nothing-      _ ->-        ksucc inp Nothing--  comment = isBlockComment >>= \case-    Just True  -> Just <$> blockComment "{-"-    Just False -> Just <$> lineComment "--"-    Nothing    -> pure $ Nothing--  lineComment acc = do-    comm <- nextWhile (\c -> c /= '\r' && c /= '\n')-    pure $ Comment (acc <> comm)--  blockComment acc = do-    chs <- nextWhile (/= '-')-    dashes <- nextWhile (== '-')-    if Text.null dashes-      then pure $ Comment $ acc <> chs-      else peek >>= \case-        Just '}' -> next $> Comment (acc <> chs <> dashes <> "}")-        _ -> blockComment (acc <> chs <> dashes)--token :: Lexer Token-token = peek >>= maybe (pure TokEof) k0-  where-  k0 ch1 = case ch1 of-    '('  -> next *> leftParen-    ')'  -> next $> TokRightParen-    '{'  -> next $> TokLeftBrace-    '}'  -> next $> TokRightBrace-    '['  -> next $> TokLeftSquare-    ']'  -> next $> TokRightSquare-    '`'  -> next $> TokTick-    ','  -> next $> TokComma-    '∷'  -> next *> orOperator1 (TokDoubleColon Unicode) ch1-    '←'  -> next *> orOperator1 (TokLeftArrow Unicode) ch1-    '→'  -> next *> orOperator1 (TokRightArrow Unicode) ch1-    '⇒'  -> next *> orOperator1 (TokRightFatArrow Unicode) ch1-    '∀'  -> next *> orOperator1 (TokForall Unicode) ch1-    '|'  -> next *> orOperator1 TokPipe ch1-    '.'  -> next *> orOperator1 TokDot ch1-    '\\' -> next *> orOperator1 TokBackslash ch1-    '<'  -> next *> orOperator2 (TokLeftArrow ASCII) ch1 '-'-    '-'  -> next *> orOperator2 (TokRightArrow ASCII) ch1 '>'-    '='  -> next *> orOperator2' TokEquals (TokRightFatArrow ASCII) ch1 '>'-    ':'  -> next *> orOperator2' (TokOperator [] ":") (TokDoubleColon ASCII) ch1 ':'-    '?'  -> next *> hole-    '\'' -> next *> char-    '"'  -> next *> string-    _  | Char.isDigit ch1 -> restore (== ErrNumberOutOfRange) (next *> number ch1)-       | Char.isUpper ch1 -> next *> upper [] ch1-       | isIdentStart ch1 -> next *> lower [] ch1-       | isSymbolChar ch1 -> next *> operator [] [ch1]-       | otherwise        -> throw $ ErrLexeme (Just [ch1]) []--  {-# INLINE orOperator1 #-}-  orOperator1 :: Token -> Char -> Lexer Token-  orOperator1 tok ch1 = join $ Parser $ \inp _ ksucc ->-    case Text.uncons inp of-      Just (ch2, inp2) | isSymbolChar ch2 ->-        ksucc inp2 $ operator [] [ch1, ch2]-      _ ->-        ksucc inp $ pure tok--  {-# INLINE orOperator2 #-}-  orOperator2 :: Token -> Char -> Char -> Lexer Token-  orOperator2 tok ch1 ch2 = join $ Parser $ \inp _ ksucc ->-    case Text.uncons inp of-      Just (ch2', inp2) | ch2 == ch2' ->-        case Text.uncons inp2 of-          Just (ch3, inp3) | isSymbolChar ch3 ->-            ksucc inp3 $ operator [] [ch1, ch2, ch3]-          _ ->-            ksucc inp2 $ pure tok-      _ ->-        ksucc inp $ operator [] [ch1]--  {-# INLINE orOperator2' #-}-  orOperator2' :: Token -> Token -> Char -> Char -> Lexer Token-  orOperator2' tok1 tok2 ch1 ch2 = join $ Parser $ \inp _ ksucc ->-    case Text.uncons inp of-      Just (ch2', inp2) | ch2 == ch2' ->-        case Text.uncons inp2 of-          Just (ch3, inp3) | isSymbolChar ch3 ->-            ksucc inp3 $ operator [] [ch1, ch2, ch3]-          _ ->-            ksucc inp2 $ pure tok2-      Just (ch2', inp2) | isSymbolChar ch2' ->-        ksucc inp2 $ operator [] [ch1, ch2']-      _ ->-        ksucc inp $ pure tok1--  {--    leftParen-      : '(' '→'  ')'-      | '(' '->' ')'-      | '('  symbolChar+  ')'-      | '('-  -}-  leftParen :: Lexer Token-  leftParen = Parser $ \inp kerr ksucc ->-    case Text.span isSymbolChar inp of-      (chs, inp2)-        | Text.null chs -> ksucc inp TokLeftParen-        | otherwise ->-            case Text.uncons inp2 of-              Just (')', inp3) ->-                case chs of-                  "→"  -> ksucc inp3 $ TokSymbolArr Unicode-                  "->" -> ksucc inp3 $ TokSymbolArr ASCII-                  _ | isReservedSymbol chs -> kerr inp ErrReservedSymbol-                    | otherwise -> ksucc inp3 $ TokSymbolName [] chs-              _ -> ksucc inp TokLeftParen--  {--    symbol-      : '(' symbolChar+ ')'-  -}-  symbol :: [Text] -> Lexer Token-  symbol qual = restore isReservedSymbolError $ peek >>= \case-    Just ch | isSymbolChar ch ->-      nextWhile isSymbolChar >>= \chs ->-        peek >>= \case-          Just ')'-            | isReservedSymbol chs -> throw ErrReservedSymbol-            | otherwise -> next $> TokSymbolName qual chs-          Just ch2 -> throw $ ErrLexeme (Just [ch2]) []-          Nothing  -> throw ErrEof-    Just ch -> throw $ ErrLexeme (Just [ch]) []-    Nothing -> throw ErrEof--  {--    operator-      : symbolChar+-  -}-  operator :: [Text] -> [Char] -> Lexer Token-  operator qual pre = do-    rest <- nextWhile isSymbolChar-    pure . TokOperator (reverse qual) $ Text.pack pre <> rest--  {--    moduleName-      : upperChar alphaNumChar*--    qualifier-      : (moduleName '.')* moduleName--    upper-      : (qualifier '.')? upperChar identChar*-      | qualifier '.' lowerQualified-      | qualifier '.' operator-      | qualifier '.' symbol-  -}-  upper :: [Text] -> Char -> Lexer Token-  upper qual pre = do-    rest <- nextWhile isIdentChar-    ch1  <- peek-    let name = Text.cons pre rest-    case ch1 of-      Just '.' -> do-        let qual' = name : qual-        next *> peek >>= \case-          Just '(' -> next *> symbol qual'-          Just ch2-            | Char.isUpper ch2 -> next *> upper qual' ch2-            | isIdentStart ch2 -> next *> lower qual' ch2-            | isSymbolChar ch2 -> next *> operator qual' [ch2]-            | otherwise -> throw $ ErrLexeme (Just [ch2]) []-          Nothing ->-            throw ErrEof-      _ ->-        pure $ TokUpperName (reverse qual) name--  {--    lower-      : '_'-      | 'forall'-      | lowerChar identChar*--    lowerQualified-      : lowerChar identChar*-  -}-  lower :: [Text] -> Char -> Lexer Token-  lower qual pre = do-    rest <- nextWhile isIdentChar-    case pre of-      '_' | Text.null rest ->-        if null qual-          then pure TokUnderscore-          else throw $ ErrLexeme (Just [pre]) []-      _ ->-        case Text.cons pre rest of-          "forall" | null qual -> pure $ TokForall ASCII-          name -> pure $ TokLowerName (reverse qual) name--  {--    hole-      : '?' identChar+-  -}-  hole :: Lexer Token-  hole = do-    name <- nextWhile isIdentChar-    if Text.null name-      then operator [] ['?']-      else pure $ TokHole name--  {--    char-      : "'" '\' escape "'"-      | "'" [^'] "'"-  -}-  char :: Lexer Token-  char = do-    (raw, ch) <- peek >>= \case-      Just '\\' -> do-        (raw, ch2) <- next *> escape-        pure (Text.cons '\\' raw, ch2)-      Just ch ->-        next $> (Text.singleton ch, ch)-      Nothing ->-        throw $ ErrEof-    peek >>= \case-      Just '\''-        | fromEnum ch > 0xFFFF -> throw ErrAstralCodePointInChar-        | otherwise -> next $> TokChar raw ch-      Just ch2 ->-        throw $ ErrLexeme (Just [ch2]) []-      _ ->-        throw $ ErrEof--  {--    stringPart-      : '\' escape-      | '\' [ \r\n]+ '\'-      | [^"]--    string-      : '"' stringPart* '"'-      | '"""' .* '"""'--    This assumes maximal munch for quotes. A raw string literal can end with-    any number of quotes, where the last 3 are considered the closing-    delimiter.-  -}-  string :: Lexer Token-  string = do-    quotes1 <- nextWhile (== '"')-    case Text.length quotes1 of-      0 -> do-        let-          go raw acc = do-            chs <- nextWhile isNormalStringChar-            let-              raw' = raw <> chs-              acc' = acc <> DList.fromList (Text.unpack chs)-            peek >>= \case-              Just '"'  -> next $> TokString raw' (fromString (DList.toList acc'))-              Just '\\' -> next *> goEscape (raw' <> "\\") acc'-              Just _    -> throw ErrLineFeedInString-              Nothing   -> throw ErrEof--          goEscape raw acc = do-            mbCh <- peek-            case mbCh of-              Just ch1 | isStringGapChar ch1 -> do-                gap <- nextWhile isStringGapChar-                peek >>= \case-                  Just '"'  -> next $> TokString (raw <> gap) (fromString (DList.toList acc))-                  Just '\\' -> next *> go (raw <> gap <> "\\") acc-                  Just ch   -> throw $ ErrCharInGap ch-                  Nothing   -> throw ErrEof-              _ -> do-                (raw', ch) <- escape-                go (raw <> raw') (acc <> DList.singleton ch)-        go "" mempty-      1 ->-        pure $ TokString "" ""-      n | n >= 5 -> do-        let str = Text.take 5 quotes1-        pure $ TokString str (fromString (Text.unpack str))-      _ -> do-        let-          go acc = do-            chs <- nextWhile (/= '"')-            quotes2 <- nextWhile (== '"')-            case Text.length quotes2 of-              0          -> throw ErrEof-              n | n >= 3 -> pure $ TokRawString $ acc <> chs <> Text.drop 3 quotes2-              _          -> go (acc <> chs <> quotes2)-        go ""--  {--    escape-      : 't'-      | 'r'-      | 'n'-      | "'"-      | '"'-      | 'x' [0-9a-fA-F]{0,6}-  -}-  escape :: Lexer (Text, Char)-  escape = do-    ch <- peek-    case ch of-      Just 't'  -> next $> ("t", '\t')-      Just 'r'  -> next $> ("r", '\r')-      Just 'n'  -> next $> ("n", '\n')-      Just '"'  -> next $> ("\"", '"')-      Just '\'' -> next $> ("'", '\'')-      Just '\\' -> next $> ("\\", '\\')-      Just 'x'  -> (*>) next $ Parser $ \inp kerr ksucc -> do-        let-          go n acc (ch' : chs)-            | Char.isHexDigit ch' = go (n * 16 + Char.digitToInt ch') (ch' : acc) chs-          go n acc _-            | n <= 0x10FFFF =-                ksucc (Text.drop (length acc) inp)-                  ("x" <> Text.pack (reverse acc), Char.chr n)-            | otherwise =-                kerr inp ErrCharEscape -- TODO-        go 0 [] $ Text.unpack $ Text.take 6 inp-      _ -> throw ErrCharEscape--  {--    number-      : hexadecimal-      | integer ('.'  fraction)? exponent?-  -}-  number :: Char -> Lexer Token-  number ch1 = peek >>= \ch2 -> case (ch1, ch2) of-    ('0', Just 'x') -> next *> hexadecimal-    (_, _) -> do-      mbInt <- integer1 ch1-      mbFraction <- fraction-      case (mbInt, mbFraction) of-        (Just (raw, int), Nothing) -> do-          let int' = digitsToInteger int-          exponent >>= \case-            Just (raw', exp) ->-              sciDouble (raw <> raw') $ Sci.scientific int' exp-            Nothing ->-              pure $ TokInt raw int'-        (Just (raw, int), Just (raw', frac)) -> do-          let sci = digitsToScientific int frac-          exponent >>= \case-            Just (raw'', exp) ->-              sciDouble (raw <> raw' <> raw'') $ uncurry Sci.scientific $ (+ exp) <$> sci-            Nothing ->-              sciDouble (raw <> raw') $ uncurry Sci.scientific sci-        (Nothing, Just (raw, frac)) -> do-          let sci = digitsToScientific [] frac-          exponent >>= \case-            Just (raw', exp) ->-              sciDouble (raw <> raw') $ uncurry Sci.scientific $ (+ exp) <$> sci-            Nothing ->-              sciDouble raw $ uncurry Sci.scientific sci-        (Nothing, Nothing) ->-          peek >>= \ch -> throw $ ErrLexeme (pure <$> ch) []--  sciDouble :: Text -> Sci.Scientific -> Lexer Token-  sciDouble raw sci = case Sci.toBoundedRealFloat sci of-    Left _ -> throw ErrNumberOutOfRange-    Right n -> pure $ TokNumber raw n--  {--    integer-      : '0'-      | [1-9] digits-  -}-  integer :: Lexer (Maybe (Text, String))-  integer = peek >>= \case-    Just '0' -> next *> peek >>= \case-      Just ch | isNumberChar ch -> throw ErrLeadingZero-      _ -> pure $ Just ("0", "0")-    Just ch | isDigitChar ch -> Just <$> digits-    _ -> pure $ Nothing--  {--    integer1-      : '0'-      | [1-9] digits--    This is the same as 'integer', the only difference is that this expects the-    first char to be consumed during dispatch.-  -}-  integer1 :: Char -> Lexer (Maybe (Text, String))-  integer1 = \case-    '0' -> peek >>= \case-      Just ch | isNumberChar ch -> throw ErrLeadingZero-      _ -> pure $ Just ("0", "0")-    ch | isDigitChar ch -> do-      (raw, chs) <- digits-      pure $ Just (Text.cons ch raw, ch : chs)-    _ -> pure $ Nothing--  {--    fraction-      : '.' [0-9_]+-  -}-  fraction :: Lexer (Maybe (Text, String))-  fraction = Parser $ \inp _ ksucc ->-    -- We need more than a single char lookahead for things like `1..10`.-    case Text.uncons inp of-      Just ('.', inp')-        | (raw, inp'') <- Text.span isNumberChar inp'-        , not (Text.null raw) ->-            ksucc inp'' $ Just ("." <> raw, filter (/= '_') $ Text.unpack raw)-      _ ->-        ksucc inp Nothing--  {--    digits-      : [0-9_]*--    Digits can contain underscores, which are ignored.-  -}-  digits :: Lexer (Text, String)-  digits = do-    raw <- nextWhile isNumberChar-    pure (raw, filter (/= '_') $ Text.unpack raw)--  {--    exponent-      : 'e' ('+' | '-')? integer-  -}-  exponent :: Lexer (Maybe (Text, Int))-  exponent = peek >>= \case-    Just 'e' -> do-      (neg, sign) <- next *> peek >>= \case-        Just '-' -> next $> (True, "-")-        Just '+' -> next $> (False, "+")-        _   -> pure (False, "")-      integer >>= \case-        Just (raw, chs) -> do-          let-            int | neg = negate $ digitsToInteger chs-                | otherwise = digitsToInteger chs-          pure $ Just ("e" <> sign <> raw, fromInteger int)-        Nothing -> throw ErrExpectedExponent-    _ ->-      pure Nothing--  {--    hexadecimal-      : '0x' [0-9a-fA-F]+-  -}-  hexadecimal :: Lexer Token-  hexadecimal = do-    chs <- nextWhile Char.isHexDigit-    if Text.null chs-      then throw ErrExpectedHex-      else pure $ TokInt ("0x" <> chs) $ digitsToIntegerBase 16 $ Text.unpack chs--digitsToInteger :: [Char] -> Integer-digitsToInteger = digitsToIntegerBase 10--digitsToIntegerBase :: Integer -> [Char] -> Integer-digitsToIntegerBase b = foldl' (\n c -> n * b + (toInteger (Char.digitToInt c))) 0--digitsToScientific :: [Char] -> [Char] -> (Integer, Int)-digitsToScientific = go 0 . reverse-  where-  go !exp is [] = (digitsToInteger (reverse is), exp)-  go !exp is (f : fs) = go (exp - 1) (f : is) fs--isSymbolChar :: Char -> Bool-isSymbolChar c = (c `elem` (":!#$%&*+./<=>?@\\^|-~" :: [Char])) || (not (Char.isAscii c) && Char.isSymbol c)--isReservedSymbolError :: ParserErrorType -> Bool-isReservedSymbolError = (== ErrReservedSymbol)--isReservedSymbol :: Text -> Bool-isReservedSymbol = flip elem symbols-  where-  symbols =-    [ "::"-    , "∷"-    , "<-"-    , "←"-    , "->"-    , "→"-    , "=>"-    , "⇒"-    , "∀"-    , "|"-    , "."-    , "\\"-    , "="-    ]--isIdentStart :: Char -> Bool-isIdentStart c = Char.isLower c || c == '_'--isIdentChar :: Char -> Bool-isIdentChar c = Char.isAlphaNum c || c == '_' || c == '\''--isDigitChar :: Char -> Bool-isDigitChar c = c >= '0' && c <= '9'--isNumberChar :: Char -> Bool-isNumberChar c = (c >= '0' && c <= '9') || c == '_'--isNormalStringChar :: Char -> Bool-isNormalStringChar c = c /= '"' && c /= '\\' && c /= '\r' && c /= '\n'--isStringGapChar :: Char -> Bool-isStringGapChar c = c == ' ' || c == '\r' || c == '\n'--isLineFeed :: Char -> Bool-isLineFeed c = c == '\r' || c == '\n'---- | Checks if some identifier is a valid unquoted key.-isUnquotedKey :: Text -> Bool-isUnquotedKey t =-  case Text.uncons t of-    Nothing ->-      False-    Just (hd, tl) ->-      isIdentStart hd && Text.all isIdentChar tl
− src/Language/PureScript/CST/Monad.hs 
@@ -1,174 +0,0 @@-module Language.PureScript.CST.Monad where--import Prelude--import Data.List (sortBy)-import qualified Data.List.NonEmpty as NE-import Data.Ord (comparing)-import Data.Text (Text)-import Language.PureScript.CST.Errors-import Language.PureScript.CST.Layout-import Language.PureScript.CST.Positions-import Language.PureScript.CST.Types--type LexResult = Either (LexState, ParserError) SourceToken--data LexState = LexState-  { lexPos :: SourcePos-  , lexLeading :: [Comment LineFeed]-  , lexSource :: Text-  , lexStack :: LayoutStack-  } deriving (Show)--data ParserState = ParserState-  { parserBuff :: [LexResult]-  , parserErrors :: [ParserError]-  } deriving (Show)---- | A bare bones, CPS'ed `StateT s (Except e) a`.-newtype ParserM e s a =-  Parser (forall r. s -> (s -> e -> r) -> (s -> a -> r) -> r)--type Parser = ParserM ParserError ParserState--instance Functor (ParserM e s) where-  {-# INLINE fmap #-}-  fmap f (Parser k) =-    Parser $ \st kerr ksucc ->-      k st kerr (\st' a -> ksucc st' (f a))--instance Applicative (ParserM e s) where-  {-# INLINE pure #-}-  pure a = Parser $ \st _ k -> k st a-  {-# INLINE (<*>) #-}-  Parser k1 <*> Parser k2 =-    Parser $ \st kerr ksucc ->-      k1 st kerr $ \st' f ->-        k2 st' kerr $ \st'' a ->-          ksucc st'' (f a)--instance Monad (ParserM e s) where-  {-# INLINE return #-}-  return = pure-  {-# INLINE (>>=) #-}-  Parser k1 >>= k2 =-    Parser $ \st kerr ksucc ->-      k1 st kerr $ \st' a -> do-        let Parser k3 = k2 a-        k3 st' kerr ksucc--runParser :: ParserState -> Parser a -> (ParserState, Either (NE.NonEmpty ParserError) a)-runParser st (Parser k) = k st left right-  where-  left st'@(ParserState {..}) err =-    (st', Left $ NE.sortBy (comparing errRange) $ err NE.:| parserErrors)--  right st'@(ParserState {..}) res-    | null parserErrors = (st', Right res)-    | otherwise = (st', Left $ NE.fromList $ sortBy (comparing errRange) parserErrors)--runTokenParser :: Parser a -> [LexResult] -> Either (NE.NonEmpty ParserError) a-runTokenParser p = snd . flip runParser p . flip ParserState []--{-# INLINE throw #-}-throw :: e -> ParserM e s a-throw e = Parser $ \st kerr _ -> kerr st e--parseError :: SourceToken -> Parser a-parseError tok = Parser $ \st kerr _ ->-  kerr st $ ParserError-    { errRange = tokRange . tokAnn $ tok-    , errToks = [tok]-    , errStack = [] -- TODO parserStack st-    , errType = ErrToken-    }--mkParserError :: LayoutStack -> [SourceToken] -> ParserErrorType -> ParserError-mkParserError stack toks ty =-  ParserError-    { errRange =  range-    , errToks = toks-    , errStack = stack-    , errType = ty-    }-  where-  range = case toks of-    [] -> SourceRange (SourcePos 0 0) (SourcePos 0 0)-    _  -> widen (tokRange . tokAnn $ head toks) (tokRange . tokAnn $ last toks)--addFailure :: [SourceToken] -> ParserErrorType -> Parser ()-addFailure toks ty = Parser $ \st _ ksucc ->-  ksucc (st { parserErrors = mkParserError [] toks ty : parserErrors st }) ()--addFailures :: [ParserError] -> Parser ()-addFailures errs = Parser $ \st _ ksucc ->-  ksucc (st { parserErrors = errs <> parserErrors st }) ()--parseFail' :: [SourceToken] -> ParserErrorType -> Parser a-parseFail' toks msg = Parser $ \st kerr _ -> kerr st (mkParserError [] toks msg)--parseFail :: SourceToken -> ParserErrorType -> Parser a-parseFail = parseFail' . pure--pushBack :: SourceToken -> Parser ()-pushBack tok = Parser $ \st _ ksucc ->-  ksucc (st { parserBuff = Right tok : parserBuff st }) ()--{-# INLINE tryPrefix #-}-tryPrefix :: Parser a -> Parser b -> Parser (Maybe a, b)-tryPrefix (Parser lhs) rhs = Parser $ \st kerr ksucc ->-  lhs st-    (\_ _ -> do-      let Parser k = (Nothing,) <$> rhs-      k st kerr ksucc)-    (\st' res -> do-      let Parser k = (Just res,) <$> rhs-      k st' kerr ksucc)--oneOf :: NE.NonEmpty (Parser a) -> Parser a-oneOf parsers = Parser $ \st kerr ksucc -> do-  let-    go (st', Right a) _ = (st', Right a)-    go _ (st', Right a) = (st', Right a)-    go (st1, Left errs1) (st2, Left errs2)-      | errRange (NE.last errs2) > errRange (NE.last errs1) = (st2, Left errs2)-      | otherwise = (st1, Left errs1)-  case foldr1 go $ runParser st <$> parsers of-    (st', Left errs) -> kerr (st' { parserErrors = NE.tail errs }) $ NE.head errs-    (st', Right res) -> ksucc st' res--manyDelimited :: Token -> Token -> Token -> Parser a -> Parser [a]-manyDelimited open close sep p = do-  _   <- token open-  res <- go1-  _   <- token close-  pure $ res-  where-  go1 =-    oneOf $ NE.fromList-      [ go2 . pure =<< p-      , pure []-      ]--  go2 acc =-    oneOf $ NE.fromList-      [ token sep *> (go2 . (: acc) =<< p)-      , pure (reverse acc)-      ]--token :: Token -> Parser SourceToken-token t = do-  t' <- munch-  if t == tokValue t'-    then pure t'-    else parseError t'--munch :: Parser SourceToken-munch = Parser $ \state@(ParserState {..}) kerr ksucc ->-  case parserBuff of-    Right tok : parserBuff' ->-      ksucc (state { parserBuff = parserBuff' }) tok-    Left (_,  err) : _ ->-      kerr state err-    [] ->-      error "Empty input"
− src/Language/PureScript/CST/Parser.y 
@@ -1,793 +0,0 @@-{-module Language.PureScript.CST.Parser-  ( parseType-  , parseKind-  , parseExpr-  , parseDecl-  , parseIdent-  , parseOperator-  , parseModule-  , parseImportDeclP-  , parseDeclP-  , parseExprP-  , parseTypeP-  , parseModuleNameP-  , parseQualIdentP-  , parse-  , PartialResult(..)-  ) where--import Prelude hiding (lex)--import Control.Monad ((<=<), when)-import Data.Foldable (foldl', for_)-import qualified Data.List.NonEmpty as NE-import Data.Text (Text)-import Data.Traversable (for)-import Language.PureScript.CST.Errors-import Language.PureScript.CST.Lexer-import Language.PureScript.CST.Monad-import Language.PureScript.CST.Positions-import Language.PureScript.CST.Types-import Language.PureScript.CST.Utils-import qualified Language.PureScript.Names as N-import Language.PureScript.PSString (PSString)-}--%expect 98--%name parseKind kind-%name parseType type-%name parseExpr expr-%name parseIdent ident-%name parseOperator op-%name parseModuleBody moduleBody-%name parseDecl decl-%partial parseImportDeclP importDeclP-%partial parseDeclP declP-%partial parseExprP exprP-%partial parseTypeP typeP-%partial parseModuleNameP moduleNameP-%partial parseQualIdentP qualIdentP-%partial parseModuleHeader moduleHeader-%partial parseDoStatement doStatement-%partial parseDoExpr doExpr-%partial parseDoNext doNext-%partial parseGuardExpr guardExpr-%partial parseGuardNext guardNext-%partial parseGuardStatement guardStatement-%partial parseClassSuper classSuper-%partial parseClassNameAndFundeps classNameAndFundeps-%partial parseBinderAndArrow binderAndArrow-%tokentype { SourceToken }-%monad { Parser }-%error { parseError }-%lexer { lexer } { SourceToken _ TokEof }--%token-  '('             { SourceToken _ TokLeftParen }-  ')'             { SourceToken _ TokRightParen }-  '{'             { SourceToken _ TokLeftBrace }-  '}'             { SourceToken _ TokRightBrace }-  '['             { SourceToken _ TokLeftSquare }-  ']'             { SourceToken _ TokRightSquare }-  '\{'            { SourceToken _ TokLayoutStart }-  '\}'            { SourceToken _ TokLayoutEnd }-  '\;'            { SourceToken _ TokLayoutSep }-  '<-'            { SourceToken _ (TokLeftArrow _) }-  '->'            { SourceToken _ (TokRightArrow _) }-  '<='            { SourceToken _ (TokOperator [] sym) | isLeftFatArrow sym }-  '=>'            { SourceToken _ (TokRightFatArrow _) }-  ':'             { SourceToken _ (TokOperator [] ":") }-  '::'            { SourceToken _ (TokDoubleColon _) }-  '='             { SourceToken _ TokEquals }-  '|'             { SourceToken _ TokPipe }-  '`'             { SourceToken _ TokTick }-  '.'             { SourceToken _ TokDot }-  ','             { SourceToken _ TokComma }-  '_'             { SourceToken _ TokUnderscore }-  '\\'            { SourceToken _ TokBackslash }-  '-'             { SourceToken _ (TokOperator [] "-") }-  '@'             { SourceToken _ (TokOperator [] "@") }-  '#'             { SourceToken _ (TokOperator [] "#") }-  'ado'           { SourceToken _ (TokLowerName _ "ado") }-  'as'            { SourceToken _ (TokLowerName [] "as") }-  'case'          { SourceToken _ (TokLowerName [] "case") }-  'class'         { SourceToken _ (TokLowerName [] "class") }-  'data'          { SourceToken _ (TokLowerName [] "data") }-  'derive'        { SourceToken _ (TokLowerName [] "derive") }-  'do'            { SourceToken _ (TokLowerName _ "do") }-  'else'          { SourceToken _ (TokLowerName [] "else") }-  'false'         { SourceToken _ (TokLowerName [] "false") }-  'forall'        { SourceToken _ (TokForall ASCII) }-  'forallu'       { SourceToken _ (TokForall Unicode) }-  'foreign'       { SourceToken _ (TokLowerName [] "foreign") }-  'hiding'        { SourceToken _ (TokLowerName [] "hiding") }-  'import'        { SourceToken _ (TokLowerName [] "import") }-  'if'            { SourceToken _ (TokLowerName [] "if") }-  'in'            { SourceToken _ (TokLowerName [] "in") }-  'infix'         { SourceToken _ (TokLowerName [] "infix") }-  'infixl'        { SourceToken _ (TokLowerName [] "infixl") }-  'infixr'        { SourceToken _ (TokLowerName [] "infixr") }-  'instance'      { SourceToken _ (TokLowerName [] "instance") }-  'kind'          { SourceToken _ (TokLowerName [] "kind") }-  'let'           { SourceToken _ (TokLowerName [] "let") }-  'module'        { SourceToken _ (TokLowerName [] "module") }-  'newtype'       { SourceToken _ (TokLowerName [] "newtype") }-  'of'            { SourceToken _ (TokLowerName [] "of") }-  'then'          { SourceToken _ (TokLowerName [] "then") }-  'true'          { SourceToken _ (TokLowerName [] "true") }-  'type'          { SourceToken _ (TokLowerName [] "type") }-  'where'         { SourceToken _ (TokLowerName [] "where") }-  '(->)'          { SourceToken _ (TokSymbolArr _) }-  '(..)'          { SourceToken _ (TokSymbolName [] "..") }-  LOWER           { SourceToken _ (TokLowerName [] _) }-  QUAL_LOWER      { SourceToken _ (TokLowerName _ _) }-  UPPER           { SourceToken _ (TokUpperName [] _) }-  QUAL_UPPER      { SourceToken _ (TokUpperName _ _) }-  SYMBOL          { SourceToken _ (TokSymbolName [] _) }-  QUAL_SYMBOL     { SourceToken _ (TokSymbolName _ _) }-  OPERATOR        { SourceToken _ (TokOperator [] _) }-  QUAL_OPERATOR   { SourceToken _ (TokOperator _ _) }-  LIT_HOLE        { SourceToken _ (TokHole _) }-  LIT_CHAR        { SourceToken _ (TokChar _ _) }-  LIT_STRING      { SourceToken _ (TokString _ _) }-  LIT_RAW_STRING  { SourceToken _ (TokRawString _) }-  LIT_INT         { SourceToken _ (TokInt _ _) }-  LIT_NUMBER      { SourceToken _ (TokNumber _ _) }--%%--many(a) :: { NE.NonEmpty a }-  : many1(a) { NE.reverse $1 }--many1(a) :: { NE.NonEmpty a }-  : a { pure $1 }-  | many1(a) a { NE.cons $2 $1 }--manySep(a, sep) :: { NE.NonEmpty a }-  : manySep1(a, sep) { NE.reverse $1 }--manySep1(a, sep) :: { NE.NonEmpty a }-  : a { pure $1 }-  | manySep1(a, sep) sep a { NE.cons $3 $1 }--manySepOrEmpty(a, sep) :: { [a] }-  : {- empty -} { [] }-  | manySep(a, sep) { NE.toList $1 }--manyOrEmpty(a) :: { [a] }-  : {- empty -} { [] }-  | many(a) { NE.toList $1 }--sep(a, s) :: { Separated a }-  : sep1(a, s) { separated $1 }--sep1(a, s) :: { [(SourceToken, a)] }-  : a { [(placeholder, $1)] }-  | sep1(a, s) s a { ($2, $3) : $1 }--delim(a, b, c, d) :: { Delimited b }-  : a d { Wrapped $1 Nothing $2 }-  | a sep(b, c) d { Wrapped $1 (Just $2) $3 }--moduleName :: { Name N.ModuleName }-  : UPPER {% upperToModuleName $1 }-  | QUAL_UPPER {% upperToModuleName $1 }--qualProperName :: { QualifiedName (N.ProperName a) }-  : UPPER {% toQualifiedName N.ProperName $1 }-  | QUAL_UPPER {% toQualifiedName N.ProperName $1 }--properName :: { Name (N.ProperName a) }-  : UPPER {% toName N.ProperName $1 }--qualIdent :: { QualifiedName Ident }-  : LOWER {% toQualifiedName Ident $1 }-  | QUAL_LOWER {% toQualifiedName Ident $1 }-  | 'as' {% toQualifiedName Ident $1 }-  | 'hiding' {% toQualifiedName Ident $1 }-  | 'kind' {% toQualifiedName Ident $1 }--ident :: { Name Ident }-  : LOWER {% toName Ident $1 }-  | 'as' {% toName Ident $1 }-  | 'hiding' {% toName Ident $1 }-  | 'kind' {% toName Ident $1 }--qualOp :: { QualifiedName (N.OpName a) }-  : OPERATOR {% toQualifiedName N.OpName $1 }-  | QUAL_OPERATOR {% toQualifiedName N.OpName $1 }-  | '<=' {% toQualifiedName N.OpName $1 }-  | '-' {% toQualifiedName N.OpName $1 }-  | '#' {% toQualifiedName N.OpName $1 }-  | ':' {% toQualifiedName N.OpName $1 }--op :: { Name (N.OpName a) }-  : OPERATOR {% toName N.OpName $1 }-  | '<=' {% toName N.OpName $1 }-  | '-' {% toName N.OpName $1 }-  | '#' {% toName N.OpName $1 }-  | ':' {% toName N.OpName $1 }--qualSymbol :: { QualifiedName (N.OpName a) }-  : SYMBOL {% toQualifiedName N.OpName $1 }-  | QUAL_SYMBOL {% toQualifiedName N.OpName $1 }-  | '(..)' {% toQualifiedName N.OpName $1 }--symbol :: { Name (N.OpName a) }-  : SYMBOL {% toName N.OpName $1 }-  | '(..)' {% toName N.OpName $1 }--label :: { Label }-  : LOWER { toLabel $1 }-  | LIT_STRING { toLabel $1 }-  | LIT_RAW_STRING { toLabel $1 }-  | 'ado' { toLabel $1 }-  | 'as' { toLabel $1 }-  | 'case' { toLabel $1 }-  | 'class' { toLabel $1 }-  | 'data' { toLabel $1 }-  | 'derive' { toLabel $1 }-  | 'do' { toLabel $1 }-  | 'else' { toLabel $1 }-  | 'false' { toLabel $1 }-  | 'forall' { toLabel $1 }-  | 'foreign' { toLabel $1 }-  | 'hiding' { toLabel $1 }-  | 'import' { toLabel $1 }-  | 'if' { toLabel $1 }-  | 'in' { toLabel $1 }-  | 'infix' { toLabel $1 }-  | 'infixl' { toLabel $1 }-  | 'infixr' { toLabel $1 }-  | 'instance' { toLabel $1 }-  | 'kind' { toLabel $1 }-  | 'let' { toLabel $1 }-  | 'module' { toLabel $1 }-  | 'newtype' { toLabel $1 }-  | 'of' { toLabel $1 }-  | 'then' { toLabel $1 }-  | 'true' { toLabel $1 }-  | 'type' { toLabel $1 }-  | 'where' { toLabel $1 }--hole :: { Name Ident }-  : LIT_HOLE {% toName Ident $1 }--string :: { (SourceToken, PSString) }-  : LIT_STRING { toString $1 }-  | LIT_RAW_STRING { toString $1 }--char :: { (SourceToken, Char) }-  : LIT_CHAR { toChar $1 }--number :: { (SourceToken, Either Integer Double) }-  : LIT_INT { toNumber $1 }-  | LIT_NUMBER { toNumber $1 }--int :: { (SourceToken, Integer) }-  : LIT_INT { toInt $1 }--boolean :: { (SourceToken, Bool) }-  : 'true' { toBoolean $1 }-  | 'false' { toBoolean $1 }--kind :: { Kind () }-  : kind1 { $1 }-  | kind1 '->' kind { KindArr () $1 $2 $3 }--kind1 :: { Kind () }-  : qualProperName { KindName () $1 }-  | '#' kind1 { KindRow () $1 $2 }-  | '(' kind ')' { KindParens () (Wrapped $1 $2 $3) }--type :: { Type () }-  : type1 { $1 }-  | type1 '::' kind { TypeKinded () $1 $2 $3 }--type1 :: { Type () }-  : type2 { $1 }-  | forall many(typeVarBinding) '.' type1 { TypeForall () $1 $2 $3 $4 }--type2 :: { Type () }-  : type3 { $1 }-  | type3 '->' type1 { TypeArr () $1 $2 $3 }-  | type3 '=>' type1 {% do cs <- toConstraint $1; pure $ TypeConstrained () cs $2 $3 }--type3 :: { Type () }-  : type4 { $1 }-  | type3 qualOp type4 { TypeOp () $1 $2 $3 }--type4 :: { Type () }-  : typeAtom { $1 }-  | type4 typeAtom { TypeApp () $1 $2 }--typeAtom :: { Type ()}-  : '_' { TypeWildcard () $1 }-  | ident { TypeVar () $1 }-  | qualProperName { TypeConstructor () $1 }-  | qualSymbol { TypeOpName () $1 }-  | string { uncurry (TypeString ()) $1 }-  | hole { TypeHole () $1 }-  | '(->)' { TypeArrName () $1 }-  | '{' row '}' { TypeRecord () (Wrapped $1 $2 $3) }-  | '(' row ')' { TypeRow () (Wrapped $1 $2 $3) }-  | '(' type1 ')' { TypeParens () (Wrapped $1 $2 $3) }-  | '(' typeKindedAtom '::' kind ')' { TypeParens () (Wrapped $1 (TypeKinded () $2 $3 $4) $5) }---- Due to a conflict between row syntax and kinded type syntax, we require--- kinded type variables to be wrapped in parens. Thus `(a :: Foo)` is always a--- row, and to annotate `a` with kind `Foo`, one must use `((a) :: Foo)`.-typeKindedAtom :: { Type () }-  : '_' { TypeWildcard () $1 }-  | qualProperName { TypeConstructor () $1 }-  | qualSymbol { TypeOpName () $1 }-  | hole { TypeHole () $1 }-  | '{' row '}' { TypeRecord () (Wrapped $1 $2 $3) }-  | '(' row ')' { TypeRow () (Wrapped $1 $2 $3) }-  | '(' type1 ')' { TypeParens () (Wrapped $1 $2 $3) }-  | '(' typeKindedAtom '::' kind ')' { TypeParens () (Wrapped $1 (TypeKinded () $2 $3 $4) $5) }--row :: { Row () }-  : {- empty -} { Row Nothing Nothing }-  | '|' type { Row Nothing (Just ($1, $2)) }-  | sep(rowLabel, ',') { Row (Just $1) Nothing }-  | sep(rowLabel, ',') '|' type { Row (Just $1) (Just ($2, $3)) }--rowLabel :: { Labeled Label (Type ()) }-  : label '::' type { Labeled $1 $2 $3 }--typeVarBinding :: { TypeVarBinding () }-  : ident { TypeVarName $1 }-  | '(' ident '::' kind ')' { TypeVarKinded (Wrapped $1 (Labeled $2 $3 $4) $5) }--forall :: { SourceToken }-  : 'forall' { $1 }-  | 'forallu' { $1 }--exprWhere :: { Where () }-  : expr { Where $1 Nothing }-  | expr 'where' '\{' manySep(letBinding, '\;') '\}' { Where $1 (Just ($2, $4)) }--expr :: { Expr () }-  : expr1 { $1 }-  | expr1 '::' type { ExprTyped () $1 $2 $3 }--expr1 :: { Expr () }-  : expr2 { $1 }-  | expr1 qualOp expr2 { ExprOp () $1 $2 $3 }--expr2 :: { Expr () }-  : expr3 { $1 }-  | expr2 '`' exprBacktick '`' expr3 { ExprInfix () $1 (Wrapped $2 $3 $4) $5 }--exprBacktick :: { Expr () }-  : expr3 { $1 }-  | exprBacktick qualOp expr3 { ExprOp () $1 $2 $3 }--expr3 :: { Expr () }-  : expr4 { $1 }-  | '-' expr3 { ExprNegate () $1 $2 }--expr4 :: { Expr () }-  : expr5 { $1 }-  | expr4 expr5-      { -- Record application/updates can introduce a function application-        -- associated to the right, so we need to correct it.-        case $2 of-          ExprApp _ lhs rhs ->-            ExprApp () (ExprApp () $1 lhs) rhs-          _ -> ExprApp () $1 $2-      }--expr5 :: { Expr () }-  : expr6 { $1 }-  | 'if' expr 'then' expr 'else' expr { ExprIf () (IfThenElse $1 $2 $3 $4 $5 $6) }-  | doBlock { ExprDo () $1 }-  | adoBlock 'in' expr { ExprAdo () $ uncurry AdoBlock $1 $2 $3 }-  | '\\' many(binderAtom) '->' expr { ExprLambda () (Lambda $1 $2 $3 $4) }-  | 'let' '\{' manySep(letBinding, '\;') '\}' 'in' expr { ExprLet () (LetIn $1 $3 $5 $6) }-  | 'case' sep(expr, ',') 'of' '\{' manySep(caseBranch, '\;') '\}' { ExprCase () (CaseOf $1 $2 $3 $5) }-  -- These special cases handle some idiosynchratic syntax that the current-  -- parser allows. Technically the parser allows the rhs of a case branch to be-  -- at any level, but this is ambiguous. We allow it in the case of a singleton-  -- case, since this is used in the wild.-  | 'case' sep(expr, ',') 'of' '\{' sep(binder1, ',') '->' '\}' exprWhere-      { ExprCase () (CaseOf $1 $2 $3 (pure ($5, Unconditional $6 $8))) }-  | 'case' sep(expr, ',') 'of' '\{' sep(binder1, ',') '\}' guardedCase-      { ExprCase () (CaseOf $1 $2 $3 (pure ($5, $7))) }--expr6 :: { Expr () }-  : expr7 { $1 }-  | expr7 '{' '}' { ExprApp () $1 (ExprRecord () (Wrapped $2 Nothing $3)) }-  | expr7 '{' sep(recordUpdateOrLabel, ',') '}'-      {% toRecordFields $3 >>= \case-          Left xs -> pure $ ExprApp () $1 (ExprRecord () (Wrapped $2 (Just xs) $4))-          Right xs -> pure $ ExprRecordUpdate () $1 (Wrapped $2 xs $4)-      }--expr7 :: { Expr () }-  : exprAtom { $1 }-  | exprAtom '.' sep(label, '.') { ExprRecordAccessor () (RecordAccessor $1 $2 $3) }--exprAtom :: { Expr () }-  : '_' { ExprSection () $1 }-  | hole { ExprHole () $1 }-  | qualIdent { ExprIdent () $1 }-  | qualProperName { ExprConstructor () $1 }-  | qualSymbol { ExprOpName () $1 }-  | boolean { uncurry (ExprBoolean ()) $1 }-  | char { uncurry (ExprChar ()) $1 }-  | string { uncurry (ExprString ()) $1 }-  | number { uncurry (ExprNumber ()) $1 }-  | delim('[', expr, ',', ']') { ExprArray () $1 }-  | delim('{', recordLabel, ',', '}') { ExprRecord () $1 }-  | '(' expr ')' { ExprParens () (Wrapped $1 $2 $3) }--recordLabel :: { RecordLabeled (Expr ()) }-  : label {% fmap RecordPun . toName Ident $ lblTok $1 }-  | label '=' expr {% addFailure [$2] ErrRecordUpdateInCtr *> pure (RecordPun $ unexpectedName $ lblTok $1) }-  | label ':' expr { RecordField $1 $2 $3 }--recordUpdateOrLabel :: { Either (RecordLabeled (Expr ())) (RecordUpdate ()) }-  : label ':' expr { Left (RecordField $1 $2 $3) }-  | label {% fmap (Left . RecordPun) . toName Ident $ lblTok $1 }-  | label '=' expr { Right (RecordUpdateLeaf $1 $2 $3) }-  | label '{' sep(recordUpdate, ',') '}' { Right (RecordUpdateBranch $1 (Wrapped $2 $3 $4)) }--recordUpdate :: { RecordUpdate () }-  : label '=' expr { RecordUpdateLeaf $1 $2 $3 }-  | label '{' sep(recordUpdate, ',') '}' { RecordUpdateBranch $1 (Wrapped $2 $3 $4) }--letBinding :: { LetBinding () }-  : ident '::' type { LetBindingSignature () (Labeled $1 $2 $3) }-  | ident guardedDecl { LetBindingName () (ValueBindingFields $1 [] $2) }-  | ident many(binderAtom) guardedDecl { LetBindingName () (ValueBindingFields $1 (NE.toList $2) $3) }-  | binder1 '=' exprWhere { LetBindingPattern () $1 $2 $3 }--caseBranch :: { (Separated (Binder ()), Guarded ()) }-  : sep(binder1, ',') guardedCase { ($1, $2) }--guardedDecl :: { Guarded () }-  : '=' exprWhere { Unconditional $1 $2 }-  | many(guardedDeclExpr) { Guarded $1 }--guardedDeclExpr :: { GuardedExpr () }-  : guard '=' exprWhere { uncurry GuardedExpr $1 $2 $3 }--guardedCase :: { Guarded () }-  : '->' exprWhere { Unconditional $1 $2 }-  | many(guardedCaseExpr) { Guarded $1 }--guardedCaseExpr :: { GuardedExpr () }-  : guard '->' exprWhere { uncurry GuardedExpr $1 $2 $3 }---- Do/Ado statements and pattern guards require unbounded lookahead due to many--- conflicts between `binder` and `expr` syntax. For example `Foo a b c` can--- either be a constructor `binder` or several `expr` applications, and we won't--- know until we see a `<-` or layout separator.------ One way to resolve this would be to parse a `binder` as an `expr` and then--- reassociate it after the fact. However this means we can't use the `binder`--- productions to parse it, so we'd have to maintain an ad-hoc handwritten--- parser which is very difficult to audit.------ As an alternative we introduce some backtracking. Using %partial parsers and--- monadic reductions, we can invoke productions manually and use the--- backtracking `tryPrefix` combinator. Binders are generally very short in--- comparison to expressions, so the cost is modest.------     doBlock---       : 'do' '\{' manySep(doStatement, '\;') '\}'------     doStatement---       : 'let' '\{' manySep(letBinding, '\;') '\}'---       | expr---       | binder '<-' expr------     guard---       : '|' sep(patternGuard, ',')------     patternGuard---       : expr1---       | binder '<-' expr1----doBlock :: { DoBlock () }-  : 'do' '\{'-      {%% revert $ do-        res <- parseDoStatement-        when (null res) $ addFailure [$2] ErrEmptyDo-        pure $ DoBlock $1 $ NE.fromList res-      }--adoBlock :: { (SourceToken, [DoStatement ()]) }-  : 'ado' '\{' '\}' { ($1, []) }-  | 'ado' '\{'-      {%% revert $ fmap ($1,) parseDoStatement }--doStatement :: { [DoStatement ()] }-  : 'let' '\{' manySep(letBinding, '\;') '\}'-      {%^ revert $ fmap (DoLet $1 $3 :) parseDoNext }-  | {- empty -}-      {%^ revert $ do-        stmt <- tryPrefix parseBinderAndArrow parseDoExpr-        let-          ctr = case stmt of-            (Just (binder, sep), expr) ->-              (DoBind binder sep expr :)-            (Nothing, expr) ->-              (DoDiscard expr :)-        fmap ctr parseDoNext-      }--doExpr :: { Expr () }-  : expr {%^ revert $ pure $1 }--doNext :: { [DoStatement ()] }-  : '\;' {%^ revert parseDoStatement }-  | '\}' {%^ revert $ pure [] }--guard :: { (SourceToken, Separated (PatternGuard ())) }-  : '|' {%% revert $ fmap (($1,) . uncurry Separated) parseGuardStatement }--guardStatement :: { (PatternGuard (), [(SourceToken, PatternGuard ())]) }-  : {- empty -}-      {%^ revert $ do-        grd <- fmap (uncurry PatternGuard) $ tryPrefix parseBinderAndArrow parseGuardExpr-        fmap (grd,) parseGuardNext-      }--guardExpr :: { Expr() }-  : expr1 {%^ revert $ pure $1 }--guardNext :: { [(SourceToken, PatternGuard ())] }-  : ',' {%^ revert $ fmap (\(g, gs) -> ($1, g) : gs) parseGuardStatement }-  | {- empty -} {%^ revert $ pure [] }--binderAndArrow :: { (Binder (), SourceToken) }-  : binder '<-' {%^ revert $ pure ($1, $2) }--binder :: { Binder () }-  : binder1 { $1 }-  | binder1 '::' type { BinderTyped () $1 $2 $3 }--binder1 :: { Binder () }-  : binder2 { $1 }-  | binder1 qualOp binder2 { BinderOp () $1 $2 $3 }--binder2 :: { Binder () }-  : many(binderAtom) {% toBinderConstructor $1 }--binderAtom :: { Binder () }-  : '_' { BinderWildcard () $1 }-  | ident { BinderVar () $1 }-  | ident '@' binderAtom { BinderNamed () $1 $2 $3 }-  | qualProperName { BinderConstructor () $1 [] }-  | boolean { uncurry (BinderBoolean ()) $1 }-  | char { uncurry (BinderChar ()) $1 }-  | string { uncurry (BinderString ()) $1 }-  | number { uncurry (BinderNumber () Nothing) $1 }-  | '-' number { uncurry (BinderNumber () (Just $1)) $2 }-  | delim('[', binder, ',', ']') { BinderArray () $1 }-  | delim('{', recordBinder, ',', '}') { BinderRecord () $1 }-  | '(' binder ')' { BinderParens () (Wrapped $1 $2 $3) }--recordBinder :: { RecordLabeled (Binder ()) }-  : label {% fmap RecordPun . toName Ident $ lblTok $1 }-  | label '=' binder {% addFailure [$2] ErrRecordUpdateInCtr *> pure (RecordPun $ unexpectedName $ lblTok $1) }-  | label ':' binder { RecordField $1 $2 $3 }---- By splitting up the module header from the body, we can incrementally parse--- just the header, and then continue parsing the body while still sharing work.-moduleHeader :: { Module () }-  : 'module' moduleName exports 'where' '\{' moduleImports-      { (Module () $1 $2 $3 $4 $6 [] []) }--moduleBody :: { ([Declaration ()], [Comment LineFeed]) }-  : moduleDecls '\}'-      {%^ \(SourceToken ann _) -> pure (snd $1, tokLeadingComments ann) }--moduleImports :: { [ImportDecl ()] }-  : importDecls importDecl '\}'-      {%^ revert $ pushBack $3 *> pure (reverse ($2 : $1)) }-  | importDecls-      {%^ revert $ pure (reverse $1) }--importDecls :: { [ImportDecl ()] }-  : importDecls importDecl '\;' { $2 : $1 }-  | {- empty -} { [] }--moduleDecls :: { ([ImportDecl ()], [Declaration ()]) }-  : manySep(moduleDecl, '\;') {% toModuleDecls $ NE.toList $1 }-  | {- empty -} { ([], []) }--moduleDecl :: { TmpModuleDecl a }-  : importDecl { TmpImport $1 }-  | sep(decl, declElse) { TmpChain $1 }--declElse :: { SourceToken }-  : 'else' { $1 }-  | 'else' '\;' { $1 }--exports :: { Maybe (DelimitedNonEmpty (Export ())) }-  : {- empty -} { Nothing }-  | '(' sep(export, ',') ')' { Just (Wrapped $1 $2 $3) }--export :: { Export () }-  : ident { ExportValue () $1 }-  | symbol { ExportOp () $1 }-  | properName { ExportType () $1 Nothing }-  | properName dataMembers { ExportType () $1 (Just $2) }-  | 'type' symbol { ExportTypeOp () $1 $2 }-  | 'class' properName { ExportClass () $1 $2 }-  | 'kind' properName { ExportKind () $1 $2 }-  | 'module' moduleName { ExportModule () $1 $2 }--dataMembers :: { (DataMembers ()) }- : '(..)' { DataAll () $1 }- | '(' ')' { DataEnumerated () (Wrapped $1 Nothing $2) }- | '(' sep(properName, ',') ')' { DataEnumerated () (Wrapped $1 (Just $2) $3) }--importDecl :: { ImportDecl () }-  : 'import' moduleName imports { ImportDecl () $1 $2 $3 Nothing }-  | 'import' moduleName imports 'as' moduleName { ImportDecl () $1 $2 $3 (Just ($4, $5)) }--imports :: { Maybe (Maybe SourceToken, DelimitedNonEmpty (Import ())) }-  : {- empty -} { Nothing }-  | '(' sep(import, ',') ')' { Just (Nothing, Wrapped $1 $2 $3) }-  | 'hiding' '(' sep(import, ',') ')' { Just (Just $1, Wrapped $2 $3 $4) }--import :: { Import () }-  : ident { ImportValue () $1 }-  | symbol { ImportOp () $1 }-  | properName { ImportType () $1 Nothing }-  | properName dataMembers { ImportType () $1 (Just $2) }-  | 'type' symbol { ImportTypeOp () $1 $2 }-  | 'class' properName { ImportClass () $1 $2 }-  | 'kind' properName { ImportKind () $1 $2 }--decl :: { Declaration () }-  : dataHead { DeclData () $1 Nothing }-  | dataHead '=' sep(dataCtor, '|') { DeclData () $1 (Just ($2, $3)) }-  | typeHead '=' type {% checkNoWildcards $3 *> pure (DeclType () $1 $2 $3) }-  | newtypeHead '=' properName typeAtom {% checkNoWildcards $4 *> pure (DeclNewtype () $1 $2 $3 $4) }-  | classHead {% checkFundeps $1 *> pure (DeclClass () $1 Nothing) }-  | classHead 'where' '\{' manySep(classMember, '\;') '\}' {% checkFundeps $1 *> pure (DeclClass () $1 (Just ($2, $4))) }-  | instHead { DeclInstanceChain () (Separated (Instance $1 Nothing) []) }-  | instHead 'where' '\{' manySep(instBinding, '\;') '\}' { DeclInstanceChain () (Separated (Instance $1 (Just ($2, $4))) []) }-  | 'derive' instHead { DeclDerive () $1 Nothing $2 }-  | 'derive' 'newtype' instHead { DeclDerive () $1 (Just $2) $3 }-  | ident '::' type { DeclSignature () (Labeled $1 $2 $3) }-  | ident manyOrEmpty(binderAtom) guardedDecl { DeclValue () (ValueBindingFields $1 $2 $3) }-  | fixity { DeclFixity () $1 }-  | 'foreign' 'import' foreign { DeclForeign () $1 $2 $3 }--dataHead :: { DataHead () }-  : 'data' properName manyOrEmpty(typeVarBinding) { DataHead $1 $2 $3 }--typeHead :: { DataHead () }-  : 'type' properName manyOrEmpty(typeVarBinding) { DataHead $1 $2 $3 }--newtypeHead :: { DataHead () }-  : 'newtype' properName manyOrEmpty(typeVarBinding) { DataHead $1 $2 $3 }--dataCtor :: { DataCtor () }-  : properName manyOrEmpty(typeAtom)-      {% for_ $2 checkNoWildcards *> pure (DataCtor () $1 $2) }---- Class head syntax requires unbounded lookahead due to a conflict between--- row syntax and `typeVarBinding`. `(a :: B)` is either a row in `constraint`--- where `B` is a type or a `typeVarBinding` where `B` is a kind. We must see--- either a `<=`, `where`, or layout delimiter before deciding which it is.------     classHead---       : 'class' classNameAndFundeps---       | 'class' constraints '<=' classNameAndFundeps----classHead :: { ClassHead () }-  : 'class'-      {%% revert $ do-        let-          ctr (super, (name, vars, fundeps)) =-            ClassHead $1 super name vars fundeps-        fmap ctr $ tryPrefix parseClassSuper parseClassNameAndFundeps-      }--classSuper-  : constraints '<=' {%^ revert $ pure ($1, $2) }--classNameAndFundeps :: { (Name (N.ProperName 'N.ClassName), [TypeVarBinding ()], Maybe (SourceToken, Separated ClassFundep)) }-  : properName manyOrEmpty(typeVarBinding) fundeps {%^ revert $ pure ($1, $2, $3) }--fundeps :: { Maybe (SourceToken, Separated ClassFundep) }-  : {- empty -} { Nothing }-  | '|' sep(fundep, ',') { Just ($1, $2) }--fundep :: { ClassFundep }-  : '->' many(ident) { FundepDetermined $1 $2 }-  | many(ident) '->' many(ident) { FundepDetermines $1 $2 $3 }--classMember :: { Labeled (Name Ident) (Type ()) }-  : ident '::' type {% checkNoWildcards $3 *> pure (Labeled $1 $2 $3) }--instHead :: { InstanceHead () }-  : 'instance' ident '::' constraints '=>' qualProperName manyOrEmpty(typeAtom)-      { InstanceHead $1 $2 $3 (Just ($4, $5)) $6 $7 }-  | 'instance' ident '::' qualProperName manyOrEmpty(typeAtom)-      { InstanceHead $1 $2 $3 Nothing $4 $5 }--constraints :: { OneOrDelimited (Constraint ()) }-  : constraint { One $1 }-  | '(' sep(constraint, ',') ')' { Many (Wrapped $1 $2 $3) }--constraint :: { Constraint () }-  : qualProperName manyOrEmpty(typeAtom) {% for_ $2 checkNoWildcards *> for_ $2 checkNoForalls *> pure (Constraint () $1 $2) }-  | '(' constraint ')' { ConstraintParens () (Wrapped $1 $2 $3) }--instBinding :: { InstanceBinding () }-  : ident '::' type { InstanceBindingSignature () (Labeled $1 $2 $3) }-  | ident manyOrEmpty(binderAtom) guardedDecl { InstanceBindingName () (ValueBindingFields $1 $2 $3) }--fixity :: { FixityFields }-  : infix int qualIdent 'as' op { FixityFields $1 $2 (FixityValue (fmap Left $3) $4 $5) }-  | infix int qualProperName 'as' op { FixityFields $1 $2 (FixityValue (fmap Right $3) $4 $5) }-  | infix int 'type' qualProperName 'as' op { FixityFields $1 $2 (FixityType $3 $4 $5 $6) }--infix :: { (SourceToken, Fixity) }-  : 'infix' { ($1, Infix) }-  | 'infixl' { ($1, Infixl) }-  | 'infixr' { ($1, Infixr) }--foreign :: { Foreign () }-  : ident '::' type { ForeignValue (Labeled $1 $2 $3) }-  | 'data' properName '::' kind { ForeignData $1 (Labeled $2 $3 $4) }-  | 'kind' properName { ForeignKind $1 $2 }---- Partial parsers which can be combined with combinators for adhoc use. We need--- to revert the lookahead token so that it doesn't consume an extra token--- before succeeding.--importDeclP :: { ImportDecl () }-  : importDecl {%^ revert $ pure $1 }--declP :: { Declaration () }-  : decl {%^ revert $ pure $1 }--exprP :: { Expr () }-  : expr {%^ revert $ pure $1 }--typeP :: { Type () }-  : type {%^ revert $ pure $1 }--moduleNameP :: { Name N.ModuleName }-  : moduleName {%^ revert $ pure $1 }--qualIdentP :: { QualifiedName Ident }-  : qualIdent {%^ revert $ pure $1 }--{-lexer :: (SourceToken -> Parser a) -> Parser a-lexer k = munch >>= k--parse :: Text -> Either (NE.NonEmpty ParserError) (Module ())-parse = resFull <=< parseModule . lex--data PartialResult a = PartialResult-  { resPartial :: a-  , resFull :: Either (NE.NonEmpty ParserError) a-  } deriving (Functor)--parseModule :: [LexResult] -> Either (NE.NonEmpty ParserError) (PartialResult (Module ()))-parseModule toks = fmap (\header -> PartialResult header (parseFull header)) headerRes-  where-  (st, headerRes) =-    runParser (ParserState (toks) []) parseModuleHeader--  parseFull header = do-    (decls, trailing) <- snd $ runParser st parseModuleBody-    pure $ header-      { modDecls = decls-      , modTrailingComments = trailing-      }-}
− src/Language/PureScript/CST/Positions.hs 
@@ -1,352 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}---- | This module contains utilities for calculating positions and offsets. While--- tokens are annotated with ranges, CST nodes are not, but they can be--- dynamically derived with the functions in this module, which will return the--- first and last tokens for a given node.--module Language.PureScript.CST.Positions where--import Prelude--import Data.Foldable (foldl')-import qualified Data.List.NonEmpty as NE-import Data.Text (Text)-import Data.Void (Void)-import qualified Data.Text as Text-import Language.PureScript.CST.Types--advanceToken :: SourcePos -> Token -> SourcePos-advanceToken pos = applyDelta pos . tokenDelta--advanceLeading :: SourcePos -> [Comment LineFeed] -> SourcePos-advanceLeading pos = foldl' (\a -> applyDelta a . commentDelta lineDelta) pos--advanceTrailing :: SourcePos -> [Comment Void] -> SourcePos-advanceTrailing pos = foldl' (\a -> applyDelta a . commentDelta (const (0, 0))) pos--tokenDelta :: Token -> (Int, Int)-tokenDelta = \case-  TokLeftParen             -> (0, 1)-  TokRightParen            -> (0, 1)-  TokLeftBrace             -> (0, 1)-  TokRightBrace            -> (0, 1)-  TokLeftSquare            -> (0, 1)-  TokRightSquare           -> (0, 1)-  TokLeftArrow ASCII       -> (0, 2)-  TokLeftArrow Unicode     -> (0, 1)-  TokRightArrow ASCII      -> (0, 2)-  TokRightArrow Unicode    -> (0, 1)-  TokRightFatArrow ASCII   -> (0, 2)-  TokRightFatArrow Unicode -> (0, 1)-  TokDoubleColon ASCII     -> (0, 2)-  TokDoubleColon Unicode   -> (0, 1)-  TokForall ASCII          -> (0, 6)-  TokForall Unicode        -> (0, 1)-  TokEquals                -> (0, 1)-  TokPipe                  -> (0, 1)-  TokTick                  -> (0, 1)-  TokDot                   -> (0, 1)-  TokComma                 -> (0, 1)-  TokUnderscore            -> (0, 1)-  TokBackslash             -> (0, 1)-  TokLowerName qual name   -> (0, qualDelta qual + Text.length name)-  TokUpperName qual name   -> (0, qualDelta qual + Text.length name)-  TokOperator qual sym     -> (0, qualDelta qual + Text.length sym)-  TokSymbolName qual sym   -> (0, qualDelta qual + Text.length sym + 2)-  TokSymbolArr Unicode     -> (0, 3)-  TokSymbolArr ASCII       -> (0, 4)-  TokHole hole             -> (0, Text.length hole + 1)-  TokChar raw _            -> (0, Text.length raw + 2)-  TokInt raw _             -> (0, Text.length raw)-  TokNumber raw _          -> (0, Text.length raw)-  TokString raw _          -> multiLine 1 $ textDelta raw-  TokRawString raw         -> multiLine 3 $ textDelta raw-  TokLayoutStart           -> (0, 0)-  TokLayoutSep             -> (0, 0)-  TokLayoutEnd             -> (0, 0)-  TokEof                   -> (0, 0)--qualDelta :: [Text] -> Int-qualDelta = foldr ((+) . (+ 1) . Text.length) 0--multiLine :: Int -> (Int, Int) -> (Int, Int)-multiLine n (0, c) = (0, c + n + n)-multiLine n (l, c) = (l, c + n)--commentDelta :: (a -> (Int, Int)) -> Comment a -> (Int, Int)-commentDelta k = \case-  Comment raw -> textDelta raw-  Space n -> (0, n)-  Line a -> k a--lineDelta :: LineFeed -> (Int, Int)-lineDelta _ = (1, 1)--textDelta :: Text -> (Int, Int)-textDelta = Text.foldl' go (0, 0)-  where-  go (!l, !c) = \case-    '\n' -> (l + 1, 1)-    _    -> (l, c + 1)--applyDelta :: SourcePos -> (Int, Int) -> SourcePos-applyDelta (SourcePos l c) = \case-  (0, n) -> SourcePos l (c + n)-  (k, d) -> SourcePos (l + k) d--sepLast :: Separated a -> a-sepLast (Separated hd []) = hd-sepLast (Separated _ tl) = snd $ last tl--type TokenRange = (SourceToken, SourceToken)--toSourceRange :: TokenRange -> SourceRange-toSourceRange (a, b) = widen (srcRange a) (srcRange b)--widen :: SourceRange -> SourceRange -> SourceRange-widen (SourceRange s1 _) (SourceRange _ e2) = SourceRange s1 e2--srcRange :: SourceToken -> SourceRange-srcRange = tokRange . tokAnn--nameRange :: Name a -> TokenRange-nameRange a = (nameTok a, nameTok a)--qualRange :: QualifiedName a -> TokenRange-qualRange a = (qualTok a, qualTok a)--labelRange :: Label -> TokenRange-labelRange a = (lblTok a, lblTok a)--wrappedRange :: Wrapped a -> TokenRange-wrappedRange (Wrapped { wrpOpen, wrpClose }) = (wrpOpen, wrpClose)--moduleRange :: Module a -> TokenRange-moduleRange (Module { modKeyword, modWhere, modImports, modDecls }) =-  case (modImports, modDecls) of-    ([], []) -> (modKeyword, modWhere)-    (is, []) -> (modKeyword, snd . importDeclRange $ last is)-    (_,  ds) -> (modKeyword, snd . declRange $ last ds)--exportRange :: Export a -> TokenRange-exportRange = \case-  ExportValue _ a -> nameRange a-  ExportOp _ a -> nameRange a-  ExportType _ a b-    | Just b' <- b -> (nameTok a, snd $ dataMembersRange b')-    | otherwise -> nameRange a-  ExportTypeOp _ a b -> (a, nameTok b)-  ExportClass _ a b -> (a, nameTok b)-  ExportKind _ a b -> (a, nameTok b)-  ExportModule _ a b -> (a, nameTok b)--importDeclRange :: ImportDecl a -> TokenRange-importDeclRange (ImportDecl { impKeyword, impModule, impNames, impQual })-  | Just (_, modName) <- impQual = (impKeyword, nameTok modName)-  | Just (_, imports) <- impNames = (impKeyword, wrpClose imports)-  | otherwise = (impKeyword, nameTok impModule)--importRange :: Import a -> TokenRange-importRange = \case-  ImportValue _ a -> nameRange a-  ImportOp _ a -> nameRange a-  ImportType _ a b-    | Just b' <- b -> (nameTok a, snd $ dataMembersRange b')-    | otherwise -> nameRange a-  ImportTypeOp _ a b -> (a, nameTok b)-  ImportClass _ a b -> (a, nameTok b)-  ImportKind _ a b -> (a, nameTok b)--dataMembersRange :: DataMembers a -> TokenRange-dataMembersRange = \case-  DataAll _ a -> (a, a)-  DataEnumerated _ (Wrapped a _ b) -> (a, b)--declRange :: Declaration a -> TokenRange-declRange = \case-  DeclData _ hd ctors-    | Just (_, cs) <- ctors -> (fst start, snd . dataCtorRange $ sepLast cs)-    | otherwise -> start-    where start = dataHeadRange hd-  DeclType _ a _ b -> (fst $ dataHeadRange a,  snd $ typeRange b)-  DeclNewtype _ a _ _ b -> (fst $ dataHeadRange a, snd $ typeRange b)-  DeclClass _ hd body-    | Just (_, ts) <- body -> (fst start, snd . typeRange . lblValue $ NE.last ts)-    | otherwise -> start-    where start = classHeadRange hd-  DeclInstanceChain _ a -> (fst . instanceRange $ sepHead a, snd . instanceRange $ sepLast a)-  DeclDerive _ a _ b -> (a, snd $ instanceHeadRange b)-  DeclSignature _ (Labeled a _ b) -> (nameTok a, snd $ typeRange b)-  DeclValue _ a -> valueBindingFieldsRange a-  DeclFixity _ (FixityFields a _ (FixityValue _ _ b)) -> (fst a, nameTok b)-  DeclFixity _ (FixityFields a _ (FixityType _ _ _ b)) -> (fst a, nameTok b)-  DeclForeign _ a _ b -> (a, snd $ foreignRange b)--dataHeadRange :: DataHead a -> TokenRange-dataHeadRange (DataHead kw name vars)-  | [] <- vars = (kw, nameTok name)-  | otherwise = (kw, snd . typeVarBindingRange $ last vars)--dataCtorRange :: DataCtor a -> TokenRange-dataCtorRange (DataCtor _ name fields)-  | [] <- fields = nameRange name-  | otherwise = (nameTok name, snd . typeRange $ last fields)--classHeadRange :: ClassHead a -> TokenRange-classHeadRange (ClassHead kw _ name vars fdeps)-  | Just (_, fs) <- fdeps = (kw, snd .classFundepRange $ sepLast fs)-  | [] <- vars = (kw, snd $ nameRange name)-  | otherwise = (kw, snd . typeVarBindingRange $ last vars)--classFundepRange :: ClassFundep -> TokenRange-classFundepRange = \case-  FundepDetermined arr bs -> (arr, nameTok $ NE.last bs)-  FundepDetermines as _ bs -> (nameTok $ NE.head as, nameTok $ NE.last bs)--instanceRange :: Instance a -> TokenRange-instanceRange (Instance hd bd)-  | Just (_, ts) <- bd = (fst start, snd . instanceBindingRange $ NE.last ts)-  | otherwise = start-  where start = instanceHeadRange hd--instanceHeadRange :: InstanceHead a -> TokenRange-instanceHeadRange (InstanceHead kw _ _ _ cls types)-  | [] <- types = (kw, qualTok cls)-  | otherwise = (kw, snd . typeRange $ last types)--instanceBindingRange :: InstanceBinding a -> TokenRange-instanceBindingRange = \case-  InstanceBindingSignature _ (Labeled a _ b) -> (nameTok a, snd $ typeRange b)-  InstanceBindingName _ a -> valueBindingFieldsRange a--foreignRange :: Foreign a -> TokenRange-foreignRange = \case-  ForeignValue (Labeled a _ b) -> (nameTok a, snd $ typeRange b)-  ForeignData a (Labeled _ _ b) -> (a, snd $ kindRange b)-  ForeignKind a b -> (a, nameTok b)--valueBindingFieldsRange :: ValueBindingFields a -> TokenRange-valueBindingFieldsRange (ValueBindingFields a _ b) = (nameTok a, snd $ guardedRange b)--guardedRange :: Guarded a -> TokenRange-guardedRange = \case-  Unconditional a b -> (a, snd $ whereRange b)-  Guarded as -> (fst . guardedExprRange $ NE.head as, snd . guardedExprRange $ NE.last as)--guardedExprRange :: GuardedExpr a -> TokenRange-guardedExprRange (GuardedExpr a _ _ b) = (a, snd $ whereRange b)--whereRange :: Where a -> TokenRange-whereRange (Where a bs)-  | Just (_, ls) <- bs = (fst $ exprRange a, snd . letBindingRange $ NE.last ls)-  | otherwise = exprRange a--kindRange :: Kind a -> TokenRange-kindRange = \case-  KindName _ a -> qualRange a-  KindArr _ a _ b -> (fst $ kindRange a, snd $ kindRange b)-  KindRow _ a b -> (a, snd $ kindRange b)-  KindParens _ a -> wrappedRange a--typeRange :: Type a -> TokenRange-typeRange = \case-  TypeVar _ a -> nameRange a-  TypeConstructor _ a -> qualRange a-  TypeWildcard _ a -> (a, a)-  TypeHole _ a -> nameRange a-  TypeString _ a _ -> (a, a)-  TypeRow _ a -> wrappedRange a-  TypeRecord _ a -> wrappedRange a-  TypeForall _ a _ _ b -> (a, snd $ typeRange b)-  TypeKinded _ a _ b -> (fst $ typeRange a, snd $ kindRange b)-  TypeApp _ a b -> (fst $ typeRange a, snd $ typeRange b)-  TypeOp _ a _ b -> (fst $ typeRange a, snd $ typeRange b)-  TypeOpName _ a -> qualRange a-  TypeArr _ a _ b -> (fst $ typeRange a, snd $ typeRange b)-  TypeArrName _ a -> (a, a)-  TypeConstrained _ a _ b -> (fst $ constraintRange a, snd $ typeRange b)-  TypeParens _ a -> wrappedRange a--constraintRange :: Constraint a -> TokenRange-constraintRange = \case-  Constraint _ name args-    | [] <- args -> qualRange name-    | otherwise -> (qualTok name, snd . typeRange $ last args)-  ConstraintParens _ wrp -> wrappedRange wrp--typeVarBindingRange :: TypeVarBinding a -> TokenRange-typeVarBindingRange = \case-  TypeVarKinded a -> wrappedRange a-  TypeVarName a -> nameRange a--exprRange :: Expr a -> TokenRange-exprRange = \case-  ExprHole _ a -> nameRange a-  ExprSection _ a -> (a, a)-  ExprIdent _ a -> qualRange a-  ExprConstructor _ a -> qualRange a-  ExprBoolean _ a _ -> (a, a)-  ExprChar _ a _ -> (a, a)-  ExprString _ a _ -> (a, a)-  ExprNumber _ a _ -> (a, a)-  ExprArray _ a -> wrappedRange a-  ExprRecord _ a -> wrappedRange a-  ExprParens _ a -> wrappedRange a-  ExprTyped _ a _ b -> (fst $ exprRange a, snd $ typeRange b)-  ExprInfix _ a _ b -> (fst $ exprRange a, snd $ exprRange b)-  ExprOp _ a _ b -> (fst $ exprRange a, snd $ exprRange b)-  ExprOpName _ a -> qualRange a-  ExprNegate _ a b -> (a, snd $ exprRange b)-  ExprRecordAccessor _ (RecordAccessor a _ b) -> (fst $ exprRange a, lblTok $ sepLast b)-  ExprRecordUpdate _ a b -> (fst $ exprRange a, snd $ wrappedRange b)-  ExprApp _ a b -> (fst $ exprRange a, snd $ exprRange b)-  ExprLambda _ (Lambda a _ _ b) -> (a, snd $ exprRange b)-  ExprIf _ (IfThenElse a _ _ _ _ b) -> (a, snd $ exprRange b)-  ExprCase _ (CaseOf a _ _ c) -> (a, snd . guardedRange . snd $ NE.last c)-  ExprLet _ (LetIn a _ _ b) -> (a, snd $ exprRange b)-  ExprDo _ (DoBlock a b) -> (a,  snd . doStatementRange $ NE.last b)-  ExprAdo _ (AdoBlock a _ _ b) -> (a, snd $ exprRange b)--letBindingRange :: LetBinding a -> TokenRange-letBindingRange = \case-  LetBindingSignature _ (Labeled a _ b) -> (nameTok a, snd $ typeRange b)-  LetBindingName _ a -> valueBindingFieldsRange a-  LetBindingPattern _ a _ b -> (fst $ binderRange a, snd $ whereRange b)--doStatementRange :: DoStatement a -> TokenRange-doStatementRange = \case-  DoLet a bs -> (a, snd . letBindingRange $ NE.last bs)-  DoDiscard a -> exprRange a-  DoBind a _ b -> (fst $ binderRange a, snd $ exprRange b)--binderRange :: Binder a -> TokenRange-binderRange = \case-  BinderWildcard _ a -> (a, a)-  BinderVar _ a -> nameRange a-  BinderNamed _ a _ b -> (nameTok a, snd $ binderRange b)-  BinderConstructor _ a bs-    | [] <- bs -> qualRange a-    | otherwise -> (qualTok a, snd . binderRange $ last bs)-  BinderBoolean _ a _ -> (a, a)-  BinderChar _ a _ -> (a, a)-  BinderString _ a _ -> (a, a)-  BinderNumber _ a b _-    | Just a' <- a -> (a', b)-    | otherwise -> (b, b)-  BinderArray _ a -> wrappedRange a-  BinderRecord _ a -> wrappedRange a-  BinderParens _ a -> wrappedRange a-  BinderTyped _ a _ b -> (fst $ binderRange a, snd $ typeRange b)-  BinderOp _ a _ b -> (fst $ binderRange a, snd $ binderRange b)--recordUpdateRange :: RecordUpdate a -> TokenRange-recordUpdateRange = \case-  RecordUpdateLeaf a _ b -> (lblTok a, snd $ exprRange b)-  RecordUpdateBranch a (Wrapped _ _ b) -> (lblTok a, b)--recordLabeledExprRange :: RecordLabeled (Expr a) -> TokenRange-recordLabeledExprRange = \case-  RecordPun a -> nameRange a-  RecordField a _ b -> (fst $ labelRange a, snd $ exprRange b)
− src/Language/PureScript/CST/Print.hs 
@@ -1,82 +0,0 @@--- | This is just a simple token printer. It's not a full fledged formatter, but--- it is used by the layout golden tests. Printing each token in the tree with--- this printer will result in the exact input that was given to the lexer.--module Language.PureScript.CST.Print-  ( printToken-  , printTokens-  , printLeadingComment-  , printTrailingComment-  ) where--import Prelude--import Data.Text (Text)-import qualified Data.Text as Text-import Language.PureScript.CST.Types--printToken :: Token -> Text-printToken = \case-  TokLeftParen             -> "("-  TokRightParen            -> ")"-  TokLeftBrace             -> "{"-  TokRightBrace            -> "}"-  TokLeftSquare            -> "["-  TokRightSquare           -> "]"-  TokLeftArrow ASCII       -> "<-"-  TokLeftArrow Unicode     -> "←"-  TokRightArrow ASCII      -> "->"-  TokRightArrow Unicode    -> "→"-  TokRightFatArrow ASCII   -> "=>"-  TokRightFatArrow Unicode -> "⇒"-  TokDoubleColon ASCII     -> "::"-  TokDoubleColon Unicode   -> "∷"-  TokForall ASCII          -> "forall"-  TokForall Unicode        -> "∀"-  TokEquals                -> "="-  TokPipe                  -> "|"-  TokTick                  -> "`"-  TokDot                   -> "."-  TokComma                 -> ","-  TokUnderscore            -> "_"-  TokBackslash             -> "\\"-  TokLowerName qual name   -> printQual qual <> name-  TokUpperName qual name   -> printQual qual <> name-  TokOperator qual sym     -> printQual qual <> sym-  TokSymbolName qual sym   -> printQual qual <> "(" <> sym <> ")"-  TokSymbolArr Unicode     -> "(→)"-  TokSymbolArr ASCII       -> "(->)"-  TokHole hole             -> "?" <> hole-  TokChar raw _            -> "'" <> raw <> "'"-  TokString raw _          -> "\"" <> raw <> "\""-  TokRawString raw         -> "\"\"\"" <> raw <> "\"\"\""-  TokInt raw _             -> raw-  TokNumber raw _          -> raw-  TokLayoutStart           -> "{"-  TokLayoutSep             -> ";"-  TokLayoutEnd             -> "}"-  TokEof                   -> "<eof>"--printQual :: [Text] -> Text-printQual = Text.concat . map (<> ".")--printTokens :: [SourceToken] -> Text-printTokens toks = Text.concat (map pp toks)-  where-  pp (SourceToken (TokenAnn _ leading trailing) tok) =-    Text.concat (map printLeadingComment leading)-      <> printToken tok-      <> Text.concat (map printTrailingComment trailing)--printLeadingComment :: Comment LineFeed -> Text-printLeadingComment = \case-  Comment raw -> raw-  Space n -> Text.replicate n " "-  Line LF -> "\n"-  Line CRLF -> "\r\n"--printTrailingComment :: Comment void -> Text-printTrailingComment = \case-  Comment raw -> raw-  Space n -> Text.replicate n " "-  Line _ -> ""
− src/Language/PureScript/CST/Traversals.hs 
@@ -1,11 +0,0 @@-module Language.PureScript.CST.Traversals where--import Prelude--import Language.PureScript.CST.Types--everythingOnSeparated :: (r -> r -> r) -> (a -> r) -> Separated a -> r-everythingOnSeparated op k (Separated hd tl) = go hd tl-  where-  go a [] = k a-  go a (b : bs) = k a `op` go (snd b) bs
− src/Language/PureScript/CST/Traversals/Type.hs 
@@ -1,39 +0,0 @@-module Language.PureScript.CST.Traversals.Type where--import Prelude--import Language.PureScript.CST.Types-import Language.PureScript.CST.Traversals--everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r-everythingOnTypes op k = goTy-  where-  goTy ty = case ty of-    TypeVar _ _ -> k ty-    TypeConstructor _ _ -> k ty-    TypeWildcard _ _ -> k ty-    TypeHole _ _ -> k ty-    TypeString _ _ _ -> k ty-    TypeRow _ (Wrapped _ row _) -> goRow ty row-    TypeRecord _ (Wrapped _ row _) -> goRow ty row-    TypeForall _ _ _ _ ty2 -> k ty `op` goTy ty2-    TypeKinded _ ty2 _ _ -> k ty `op` goTy ty2-    TypeApp _ ty2 ty3 -> k ty `op` (goTy ty2 `op` goTy ty3)-    TypeOp _ ty2 _ ty3 -> k ty `op` (goTy ty2 `op` goTy ty3)-    TypeOpName _ _ -> k ty-    TypeArr _ ty2 _ ty3 -> k ty `op` (goTy ty2 `op` goTy ty3)-    TypeArrName _ _ -> k ty-    TypeConstrained _ (constraintTys -> ty2) _ ty3-      | null ty2 -> k ty `op` goTy ty3-      | otherwise -> k ty `op` (foldr1 op (k <$> ty2) `op` goTy ty3)-    TypeParens _ (Wrapped _ ty2 _) -> k ty `op` goTy ty2--  goRow ty = \case-    Row Nothing Nothing -> k ty-    Row Nothing (Just (_, ty2)) -> k ty `op` goTy ty2-    Row (Just lbls) Nothing -> k ty `op` everythingOnSeparated op (goTy . lblValue) lbls-    Row (Just lbls) (Just (_, ty2)) -> k ty `op` (everythingOnSeparated op (goTy . lblValue) lbls `op` goTy ty2)--  constraintTys = \case-    Constraint _ _ tys -> tys-    ConstraintParens _ (Wrapped _ c _) -> constraintTys c
− src/Language/PureScript/CST/Types.hs 
@@ -1,437 +0,0 @@--- | This module contains data types for the entire PureScript surface language. Every--- token is represented in the tree, and every token is annotated with--- whitespace and comments (both leading and trailing). This means one can write--- an exact printer so that `print . parse = id`. Every constructor is laid out--- with tokens in left-to-right order. The core productions are given a slot for--- arbitrary annotations, however this is not used by the parser.--module Language.PureScript.CST.Types where--import Prelude--import Data.List.NonEmpty (NonEmpty)-import Data.Text (Text)-import Data.Void (Void)-import GHC.Generics (Generic)-import qualified Language.PureScript.Names as N-import Language.PureScript.PSString (PSString)--data SourcePos = SourcePos-  { srcLine :: {-# UNPACK #-} !Int-  , srcColumn :: {-# UNPACK #-} !Int-  } deriving (Show, Eq, Ord, Generic)--data SourceRange = SourceRange-  { srcStart :: !SourcePos-  , srcEnd :: !SourcePos-  } deriving (Show, Eq, Ord, Generic)--data Comment l-  = Comment !Text-  | Space {-# UNPACK #-} !Int-  | Line !l-  deriving (Show, Eq, Ord, Generic, Functor)--data LineFeed = LF | CRLF-  deriving (Show, Eq, Ord, Generic)--data TokenAnn = TokenAnn-  { tokRange :: !SourceRange-  , tokLeadingComments :: ![Comment LineFeed]-  , tokTrailingComments :: ![Comment Void]-  } deriving (Show, Eq, Ord, Generic)--data SourceStyle = ASCII | Unicode-  deriving (Show, Eq, Ord, Generic)--data Token-  = TokLeftParen-  | TokRightParen-  | TokLeftBrace-  | TokRightBrace-  | TokLeftSquare-  | TokRightSquare-  | TokLeftArrow !SourceStyle-  | TokRightArrow !SourceStyle-  | TokRightFatArrow !SourceStyle-  | TokDoubleColon !SourceStyle-  | TokForall !SourceStyle-  | TokEquals-  | TokPipe-  | TokTick-  | TokDot-  | TokComma-  | TokUnderscore-  | TokBackslash-  | TokLowerName ![Text] !Text-  | TokUpperName ![Text] !Text-  | TokOperator ![Text] !Text-  | TokSymbolName ![Text] !Text-  | TokSymbolArr !SourceStyle-  | TokHole !Text-  | TokChar !Text !Char-  | TokString !Text !PSString-  | TokRawString !Text-  | TokInt !Text !Integer-  | TokNumber !Text !Double-  | TokLayoutStart-  | TokLayoutSep-  | TokLayoutEnd-  | TokEof-  deriving (Show, Eq, Ord, Generic)--data SourceToken = SourceToken-  { tokAnn :: !TokenAnn-  , tokValue :: !Token-  } deriving (Show, Eq, Ord, Generic)--data Ident = Ident-  { getIdent :: Text-  } deriving (Show, Eq, Ord, Generic)--data Name a = Name-  { nameTok :: SourceToken-  , nameValue :: a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data QualifiedName a = QualifiedName-  { qualTok :: SourceToken-  , qualModule :: Maybe N.ModuleName-  , qualName :: a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Label = Label-  { lblTok :: SourceToken-  , lblName :: PSString-  } deriving (Show, Eq, Ord, Generic)--data Wrapped a = Wrapped-  { wrpOpen :: SourceToken-  , wrpValue :: a-  , wrpClose :: SourceToken-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Separated a = Separated-  { sepHead :: a-  , sepTail :: [(SourceToken, a)]-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Labeled a b = Labeled-  { lblLabel :: a-  , lblSep :: SourceToken-  , lblValue  :: b-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--type Delimited a = Wrapped (Maybe (Separated a))-type DelimitedNonEmpty a = Wrapped (Separated a)--data OneOrDelimited a-  = One a-  | Many (DelimitedNonEmpty a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Kind a-  = KindName a (QualifiedName (N.ProperName 'N.KindName))-  | KindArr a (Kind a) SourceToken (Kind a)-  | KindRow a SourceToken (Kind a)-  | KindParens a (Wrapped (Kind a))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Type a-  = TypeVar a (Name Ident)-  | TypeConstructor a (QualifiedName (N.ProperName 'N.TypeName))-  | TypeWildcard a SourceToken-  | TypeHole a (Name Ident)-  | TypeString a SourceToken PSString-  | TypeRow a (Wrapped (Row a))-  | TypeRecord a (Wrapped (Row a))-  | TypeForall a SourceToken (NonEmpty (TypeVarBinding a)) SourceToken (Type a)-  | TypeKinded a (Type a) SourceToken (Kind a)-  | TypeApp a (Type a) (Type a)-  | TypeOp a (Type a) (QualifiedName (N.OpName 'N.TypeOpName)) (Type a)-  | TypeOpName a (QualifiedName (N.OpName 'N.TypeOpName))-  | TypeArr a (Type a) SourceToken (Type a)-  | TypeArrName a SourceToken-  | TypeConstrained a (Constraint a) SourceToken (Type a)-  | TypeParens a (Wrapped (Type a))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data TypeVarBinding a-  = TypeVarKinded (Wrapped (Labeled (Name Ident) (Kind a)))-  | TypeVarName (Name Ident)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Constraint a-  = Constraint a (QualifiedName (N.ProperName 'N.ClassName)) [Type a]-  | ConstraintParens a (Wrapped (Constraint a))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Row a = Row-  { rowLabels :: Maybe (Separated (Labeled Label (Type a)))-  , rowTail :: Maybe (SourceToken, Type a)-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Module a = Module-  { modAnn :: a-  , modKeyword :: SourceToken-  , modNamespace :: Name N.ModuleName-  , modExports :: Maybe (DelimitedNonEmpty (Export a))-  , modWhere :: SourceToken-  , modImports :: [ImportDecl a]-  , modDecls :: [Declaration a]-  , modTrailingComments :: [Comment LineFeed]-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Export a-  = ExportValue a (Name Ident)-  | ExportOp a (Name (N.OpName 'N.ValueOpName))-  | ExportType a (Name (N.ProperName 'N.TypeName)) (Maybe (DataMembers a))-  | ExportTypeOp a SourceToken (Name (N.OpName 'N.TypeOpName))-  | ExportClass a SourceToken (Name (N.ProperName 'N.ClassName))-  | ExportKind a SourceToken (Name (N.ProperName 'N.KindName))-  | ExportModule a SourceToken (Name N.ModuleName)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data DataMembers a-  = DataAll a SourceToken-  | DataEnumerated a (Delimited (Name (N.ProperName 'N.ConstructorName)))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Declaration a-  = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a)))-  | DeclType a (DataHead a) SourceToken (Type a)-  | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a)-  | DeclClass a (ClassHead a) (Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a))))-  | DeclInstanceChain a (Separated (Instance a))-  | DeclDerive a SourceToken (Maybe SourceToken) (InstanceHead a)-  | DeclSignature a (Labeled (Name Ident) (Type a))-  | DeclValue a (ValueBindingFields a)-  | DeclFixity a FixityFields-  | DeclForeign a SourceToken SourceToken (Foreign a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Instance a = Instance-  { instHead :: InstanceHead a-  , instBody :: Maybe (SourceToken, NonEmpty (InstanceBinding a))-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data InstanceBinding a-  = InstanceBindingSignature a (Labeled (Name Ident) (Type a))-  | InstanceBindingName a (ValueBindingFields a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data ImportDecl a = ImportDecl-  { impAnn :: a-  , impKeyword :: SourceToken-  , impModule :: Name N.ModuleName-  , impNames :: Maybe (Maybe SourceToken, DelimitedNonEmpty (Import a))-  , impQual :: Maybe (SourceToken, Name N.ModuleName)-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Import a-  = ImportValue a (Name Ident)-  | ImportOp a (Name (N.OpName 'N.ValueOpName))-  | ImportType a (Name (N.ProperName 'N.TypeName)) (Maybe (DataMembers a))-  | ImportTypeOp a SourceToken (Name (N.OpName 'N.TypeOpName))-  | ImportClass a SourceToken (Name (N.ProperName 'N.ClassName))-  | ImportKind a SourceToken (Name (N.ProperName 'N.KindName))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data DataHead a = DataHead-  { dataHdKeyword :: SourceToken-  , dataHdName :: Name (N.ProperName 'N.TypeName)-  , dataHdVars :: [TypeVarBinding a]-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data DataCtor a = DataCtor-  { dataCtorAnn :: a-  , dataCtorName :: Name (N.ProperName 'N.ConstructorName)-  , dataCtorFields :: [Type a]-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data ClassHead a = ClassHead-  { clsKeyword :: SourceToken-  , clsSuper :: Maybe (OneOrDelimited (Constraint a), SourceToken)-  , clsName :: Name (N.ProperName 'N.ClassName)-  , clsVars :: [TypeVarBinding a]-  , clsFundeps :: Maybe (SourceToken, Separated ClassFundep)-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data ClassFundep-  = FundepDetermined SourceToken (NonEmpty (Name Ident))-  | FundepDetermines (NonEmpty (Name Ident)) SourceToken (NonEmpty (Name Ident))-  deriving (Show, Eq, Ord, Generic)--data InstanceHead a = InstanceHead-  { instKeyword :: SourceToken-  , instName :: Name Ident-  , instSep :: SourceToken-  , instConstraints :: Maybe (OneOrDelimited (Constraint a), SourceToken)-  , instClass :: QualifiedName (N.ProperName 'N.ClassName)-  , instTypes :: [Type a]-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Fixity-  = Infix-  | Infixl-  | Infixr-  deriving (Show, Eq, Ord, Generic)--data FixityOp-  = FixityValue (QualifiedName (Either Ident (N.ProperName 'N.ConstructorName))) SourceToken (Name (N.OpName 'N.ValueOpName))-  | FixityType SourceToken (QualifiedName (N.ProperName 'N.TypeName)) SourceToken (Name (N.OpName 'N.TypeOpName))-  deriving (Show, Eq, Ord, Generic)--data FixityFields = FixityFields-  { fxtKeyword :: (SourceToken, Fixity)-  , fxtPrec :: (SourceToken, Integer)-  , fxtOp :: FixityOp-  } deriving (Show, Eq, Ord, Generic)--data ValueBindingFields a = ValueBindingFields-  { valName :: Name Ident-  , valBinders :: [Binder a]-  , valGuarded :: Guarded a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Guarded a-  = Unconditional SourceToken (Where a)-  | Guarded (NonEmpty (GuardedExpr a))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data GuardedExpr a = GuardedExpr-  { grdBar :: SourceToken-  , grdPatterns :: Separated (PatternGuard a)-  , grdSep :: SourceToken-  , grdWhere :: Where a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data PatternGuard a = PatternGuard-  { patBinder :: Maybe (Binder a, SourceToken)-  , patExpr :: Expr a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Foreign a-  = ForeignValue (Labeled (Name Ident) (Type a))-  | ForeignData SourceToken (Labeled (Name (N.ProperName 'N.TypeName)) (Kind a))-  | ForeignKind SourceToken (Name (N.ProperName 'N.KindName))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Expr a-  = ExprHole a (Name Ident)-  | ExprSection a SourceToken-  | ExprIdent a (QualifiedName Ident)-  | ExprConstructor a (QualifiedName (N.ProperName 'N.ConstructorName))-  | ExprBoolean a SourceToken Bool-  | ExprChar a SourceToken Char-  | ExprString a SourceToken PSString-  | ExprNumber a SourceToken (Either Integer Double)-  | ExprArray a (Delimited (Expr a))-  | ExprRecord a (Delimited (RecordLabeled (Expr a)))-  | ExprParens a (Wrapped (Expr a))-  | ExprTyped a (Expr a) SourceToken (Type a)-  | ExprInfix a (Expr a) (Wrapped (Expr a)) (Expr a)-  | ExprOp a (Expr a) (QualifiedName (N.OpName 'N.ValueOpName)) (Expr a)-  | ExprOpName a (QualifiedName (N.OpName 'N.ValueOpName))-  | ExprNegate a SourceToken (Expr a)-  | ExprRecordAccessor a (RecordAccessor a)-  | ExprRecordUpdate a (Expr a) (DelimitedNonEmpty (RecordUpdate a))-  | ExprApp a (Expr a) (Expr a)-  | ExprLambda a (Lambda a)-  | ExprIf a (IfThenElse a)-  | ExprCase a (CaseOf a)-  | ExprLet a (LetIn a)-  | ExprDo a (DoBlock a)-  | ExprAdo a (AdoBlock a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data RecordLabeled a-  = RecordPun (Name Ident)-  | RecordField Label SourceToken a-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data RecordUpdate a-  = RecordUpdateLeaf Label SourceToken (Expr a)-  | RecordUpdateBranch Label (DelimitedNonEmpty (RecordUpdate a))-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data RecordAccessor a = RecordAccessor-  { recExpr :: Expr a-  , recDot :: SourceToken-  , recPath :: Separated Label-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Lambda a = Lambda-  { lmbSymbol :: SourceToken-  , lmbBinders :: NonEmpty (Binder a)-  , lmbArr :: SourceToken-  , lmbBody :: Expr a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data IfThenElse a = IfThenElse-  { iteIf :: SourceToken-  , iteCond :: Expr a-  , iteThen :: SourceToken-  , iteTrue :: Expr a-  , iteElse :: SourceToken-  , iteFalse :: Expr a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data CaseOf a = CaseOf-  { caseKeyword :: SourceToken-  , caseHead :: Separated (Expr a)-  , caseOf :: SourceToken-  , caseBranches :: NonEmpty (Separated (Binder a), Guarded a)-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data LetIn a = LetIn-  { letKeyword :: SourceToken-  , letBindings :: NonEmpty (LetBinding a)-  , letIn :: SourceToken-  , letBody :: Expr a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Where a = Where-  { whereExpr :: Expr a-  , whereBindings :: Maybe (SourceToken, NonEmpty (LetBinding a))-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data LetBinding a-  = LetBindingSignature a (Labeled (Name Ident) (Type a))-  | LetBindingName a (ValueBindingFields a)-  | LetBindingPattern a (Binder a) SourceToken (Where a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data DoBlock a = DoBlock-  { doKeyword :: SourceToken-  , doStatements :: NonEmpty (DoStatement a)-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data DoStatement a-  = DoLet SourceToken (NonEmpty (LetBinding a))-  | DoDiscard (Expr a)-  | DoBind (Binder a) SourceToken (Expr a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data AdoBlock a = AdoBlock-  { adoKeyword :: SourceToken-  , adoStatements :: [DoStatement a]-  , adoIn :: SourceToken-  , adoResult :: Expr a-  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--data Binder a-  = BinderWildcard a SourceToken-  | BinderVar a (Name Ident)-  | BinderNamed a (Name Ident) SourceToken (Binder a)-  | BinderConstructor a (QualifiedName (N.ProperName 'N.ConstructorName)) [Binder a]-  | BinderBoolean a SourceToken Bool-  | BinderChar a SourceToken Char-  | BinderString a SourceToken PSString-  | BinderNumber a (Maybe SourceToken) SourceToken (Either Integer Double)-  | BinderArray a (Delimited (Binder a))-  | BinderRecord a (Delimited (RecordLabeled (Binder a)))-  | BinderParens a (Wrapped (Binder a))-  | BinderTyped a (Binder a) SourceToken (Type a)-  | BinderOp a (Binder a) (QualifiedName (N.OpName 'N.ValueOpName)) (Binder a)-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
− src/Language/PureScript/CST/Utils.hs 
@@ -1,315 +0,0 @@-{-# LANGUAGE MonoLocalBinds #-}-module Language.PureScript.CST.Utils where--import Prelude--import Control.Monad (when)-import Data.Coerce (coerce)-import Data.Foldable (for_)-import Data.Functor (($>))-import qualified Data.List.NonEmpty as NE-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Text (Text)-import qualified Data.Text as Text-import Language.PureScript.CST.Errors-import Language.PureScript.CST.Monad-import Language.PureScript.CST.Positions-import Language.PureScript.CST.Traversals.Type-import Language.PureScript.CST.Types-import qualified Language.PureScript.Names as N-import Language.PureScript.PSString (PSString, mkString)--placeholder :: SourceToken-placeholder = SourceToken-  { tokAnn = TokenAnn (SourceRange (SourcePos 0 0) (SourcePos 0 0)) [] []-  , tokValue = TokLowerName [] "<placeholder>"-  }--unexpectedName :: SourceToken -> Name Ident-unexpectedName tok = Name tok (Ident "<unexpected>")--unexpectedQual :: SourceToken -> QualifiedName Ident-unexpectedQual tok = QualifiedName tok Nothing (Ident "<unexpected>")--unexpectedLabel :: SourceToken -> Label-unexpectedLabel tok = Label tok "<unexpected>"--unexpectedExpr :: Monoid a => [SourceToken] -> Expr a-unexpectedExpr toks = ExprIdent mempty (unexpectedQual (head toks))--unexpectedDecl :: Monoid a => [SourceToken] -> Declaration a-unexpectedDecl toks = DeclValue mempty (ValueBindingFields (unexpectedName (head toks)) [] (error "<unexpected"))--unexpectedBinder :: Monoid a => [SourceToken] -> Binder a-unexpectedBinder toks = BinderVar mempty (unexpectedName (head toks))--unexpectedLetBinding :: Monoid a => [SourceToken] -> LetBinding a-unexpectedLetBinding toks = LetBindingName mempty (ValueBindingFields (unexpectedName (head toks)) [] (error "<unexpected>"))--unexpectedInstBinding :: Monoid a => [SourceToken] -> InstanceBinding a-unexpectedInstBinding toks = InstanceBindingName mempty (ValueBindingFields (unexpectedName (head toks)) [] (error "<unexpected>"))--unexpectedRecordUpdate :: Monoid a => [SourceToken] -> RecordUpdate a-unexpectedRecordUpdate toks = RecordUpdateLeaf (unexpectedLabel (head toks)) (head toks) (unexpectedExpr toks)--unexpectedRecordLabeled :: [SourceToken] -> RecordLabeled a-unexpectedRecordLabeled toks = RecordPun (unexpectedName (head toks))--rangeToks :: TokenRange -> [SourceToken]-rangeToks (a, b) = [a, b]--unexpectedToks :: (a -> TokenRange) -> ([SourceToken] -> b) -> ParserErrorType -> (a -> Parser b)-unexpectedToks toRange toCst err old = do-  let toks = rangeToks $ toRange old-  addFailure toks err-  pure $ toCst toks--separated :: [(SourceToken, a)] -> Separated a-separated = go []-  where-  go accum ((_, a) : []) = Separated a accum-  go accum (x : xs) = go (x : accum) xs-  go _ [] = internalError "Separated should not be empty"--consSeparated :: a -> SourceToken -> Separated a -> Separated a-consSeparated x sep (Separated {..}) = Separated x ((sep, sepHead) : sepTail)--internalError :: String -> a-internalError = error . ("Internal parser error: " <>)--toModuleName :: SourceToken -> [Text] -> Parser (Maybe N.ModuleName)-toModuleName _ [] = pure Nothing-toModuleName tok ns = do-  when (not (all isValidModuleNamespace ns)) $ addFailure [tok] ErrModuleName-  pure . Just . N.ModuleName $ Text.intercalate "." ns--upperToModuleName :: SourceToken -> Parser (Name N.ModuleName)-upperToModuleName tok = case tokValue tok of-  TokUpperName q a -> do-    let ns = q <> [a]-    when (not (all isValidModuleNamespace ns)) $ addFailure [tok] ErrModuleName-    pure . Name tok . N.ModuleName $ Text.intercalate "." ns-  _ -> internalError $ "Invalid upper name: " <> show tok--toQualifiedName :: (Text -> a) -> SourceToken -> Parser (QualifiedName a)-toQualifiedName k tok = case tokValue tok of-  TokLowerName q a-    | not (Set.member a reservedNames) -> flip (QualifiedName tok) (k a) <$> toModuleName tok q-    | otherwise -> addFailure [tok] ErrKeywordVar $> QualifiedName tok Nothing (k "<unexpected>")-  TokUpperName q a  -> flip (QualifiedName tok) (k a) <$> toModuleName tok q-  TokSymbolName q a -> flip (QualifiedName tok) (k a) <$> toModuleName tok q-  TokOperator q a   -> flip (QualifiedName tok) (k a) <$> toModuleName tok q-  _                 -> internalError $ "Invalid qualified name: " <> show tok--toName :: (Text -> a) -> SourceToken -> Parser (Name a)-toName k tok = case tokValue tok of-  TokLowerName [] a-    | not (Set.member a reservedNames) -> pure $ Name tok (k a)-    | otherwise -> addFailure [tok] ErrKeywordVar $> Name tok (k "<unexpected>")-  TokString _ _ -> parseFail tok ErrQuotedPun-  TokRawString _ -> parseFail tok ErrQuotedPun-  TokUpperName [] a  -> pure $ Name tok (k a)-  TokSymbolName [] a -> pure $ Name tok (k a)-  TokOperator [] a   -> pure $ Name tok (k a)-  TokHole a          -> pure $ Name tok (k a)-  _                  -> internalError $ "Invalid name: " <> show tok--toLabel :: SourceToken -> Label-toLabel tok = case tokValue tok of-  TokLowerName [] a -> Label tok $ mkString a-  TokString _ a     -> Label tok a-  TokRawString a    -> Label tok $ mkString a-  TokForall ASCII   -> Label tok $ mkString "forall"-  _                 -> internalError $ "Invalid label: " <> show tok--labelToIdent :: Label -> Parser (Name Ident)-labelToIdent (Label tok _) = toName Ident tok--toString :: SourceToken -> (SourceToken, PSString)-toString tok = case tokValue tok of-  TokString _ a  -> (tok, a)-  TokRawString a -> (tok, mkString a)-  _              -> internalError $ "Invalid string literal: " <> show tok--toChar :: SourceToken -> (SourceToken, Char)-toChar tok = case tokValue tok of-  TokChar _ a -> (tok, a)-  _           -> internalError $ "Invalid char literal: " <> show tok--toNumber :: SourceToken -> (SourceToken, Either Integer Double)-toNumber tok = case tokValue tok of-  TokInt _ a    -> (tok, Left a)-  TokNumber _ a -> (tok, Right a)-  _             -> internalError $ "Invalid number literal: " <> show tok--toInt :: SourceToken -> (SourceToken, Integer)-toInt tok = case tokValue tok of-  TokInt _ a    -> (tok, a)-  _             -> internalError $ "Invalid integer literal: " <> show tok--toBoolean :: SourceToken -> (SourceToken, Bool)-toBoolean tok = case tokValue tok of-  TokLowerName [] "true"  -> (tok, True)-  TokLowerName [] "false" -> (tok, False)-  _                       -> internalError $ "Invalid boolean literal: " <> show tok--toConstraint :: forall a. Monoid a => Type a -> Parser (Constraint a)-toConstraint = convertParens-  where-  convertParens :: Type a -> Parser (Constraint a)-  convertParens = \case-    TypeParens a (Wrapped b c d) -> do-      c' <- convertParens c-      pure $ ConstraintParens a (Wrapped b c' d)-    ty -> convert mempty [] ty--  convert :: a -> [Type a] -> Type a -> Parser (Constraint a)-  convert ann acc = \case-    TypeApp a lhs rhs -> convert (a <> ann) (rhs : acc) lhs-    TypeConstructor a name -> do-      for_ acc checkNoForalls-      pure $ Constraint (a <> ann) (coerce name) acc-    ty -> do-      let (tok1, tok2) = typeRange ty-      addFailure [tok1, tok2] ErrTypeInConstraint-      pure $ Constraint mempty (QualifiedName tok1 Nothing (N.ProperName "<unexpected")) []--toBinderConstructor :: Monoid a => NE.NonEmpty (Binder a) -> Parser (Binder a)-toBinderConstructor = \case-  BinderConstructor a name [] NE.:| bs ->-    pure $ BinderConstructor a name bs-  a NE.:| [] -> pure a-  a NE.:| _ -> unexpectedToks binderRange (unexpectedBinder) ErrExprInBinder a--toRecordFields-  :: Monoid a-  => Separated (Either (RecordLabeled (Expr a)) (RecordUpdate a))-  -> Parser (Either (Separated (RecordLabeled (Expr a))) (Separated (RecordUpdate a)))-toRecordFields = \case-  Separated (Left a) as ->-    Left . Separated a <$> traverse (traverse unLeft) as-  Separated (Right a) as ->-    Right . Separated a <$> traverse (traverse unRight) as-  where-  unLeft (Left tok) = pure tok-  unLeft (Right tok) =-    unexpectedToks recordUpdateRange unexpectedRecordLabeled ErrRecordUpdateInCtr tok--  unRight (Right tok) = pure tok-  unRight (Left (RecordPun (Name tok _))) = do-    addFailure [tok] ErrRecordPunInUpdate-    pure $ unexpectedRecordUpdate [tok]-  unRight (Left (RecordField _ tok _)) = do-    addFailure [tok] ErrRecordCtrInUpdate-    pure $ unexpectedRecordUpdate [tok]--checkFundeps :: ClassHead a -> Parser ()-checkFundeps (ClassHead _ _ _ _ Nothing) = pure ()-checkFundeps (ClassHead _ _ _ vars (Just (_, fundeps))) = do-  let-    k (TypeVarKinded (Wrapped _ (Labeled a _ _) _)) = getIdent $ nameValue a-    k (TypeVarName a) = getIdent $ nameValue a-    names = k <$> vars-    check a-      | getIdent (nameValue a) `elem` names = pure ()-      | otherwise = addFailure [nameTok a] ErrUnknownFundep-  for_ fundeps $ \case-    FundepDetermined _ bs -> for_ bs check-    FundepDetermines as _ bs -> do-      for_ as check-      for_ bs check--data TmpModuleDecl a-  = TmpImport (ImportDecl a)-  | TmpChain (Separated (Declaration a))-  deriving (Show)--toModuleDecls :: Monoid a => [TmpModuleDecl a] -> Parser ([ImportDecl a], [Declaration a])-toModuleDecls = goImport []-  where-  goImport acc (TmpImport x : xs) = goImport (x : acc) xs-  goImport acc xs = (reverse acc,) <$> goDecl [] xs--  goDecl acc [] = pure $ reverse acc-  goDecl acc (TmpChain (Separated x []) : xs) = goDecl (x : acc) xs-  goDecl acc (TmpChain (Separated (DeclInstanceChain a (Separated h t)) t') : xs) = do-    (a', instances) <- goChain (getName h) a [] t'-    goDecl (DeclInstanceChain a' (Separated h (t <> instances)) : acc) xs-  goDecl acc (TmpChain (Separated _ t) : xs) = do-    for_ t $ \(tok, _) -> addFailure [tok] ErrElseInDecl-    goDecl acc xs-  goDecl acc (TmpImport imp : xs) = do-    unexpectedToks importDeclRange (const ()) ErrImportInDecl imp-    goDecl acc xs--  goChain _ ann acc [] = pure (ann, reverse acc)-  goChain name ann acc ((tok, DeclInstanceChain a (Separated h t)) : xs)-    | eqName (getName h) name = goChain name (ann <> a) (reverse ((tok, h) : t) <> acc) xs-    | otherwise = do-        addFailure [qualTok $ getName h] ErrInstanceNameMismatch-        goChain name ann acc xs-  goChain name ann acc ((tok, _) : xs) = do-    addFailure [tok] ErrElseInDecl-    goChain name ann acc xs--  getName = instClass . instHead-  eqName (QualifiedName _ a b) (QualifiedName _ c d) = a == c && b == d--checkNoWildcards :: Type a -> Parser ()-checkNoWildcards ty = do-  let-    k = \case-      TypeWildcard _ a -> [addFailure [a] ErrWildcardInType]-      TypeHole _ a -> [addFailure [nameTok a] ErrHoleInType]-      _ -> []-  sequence_ $ everythingOnTypes (<>) k ty--checkNoForalls :: Type a -> Parser ()-checkNoForalls ty = do-  let-    k = \case-      TypeForall _ a _ _ _ -> [addFailure [a] ErrToken]-      _ -> []-  sequence_ $ everythingOnTypes (<>) k ty--revert :: Parser a -> SourceToken -> Parser a-revert p lk = pushBack lk *> p--reservedNames :: Set Text-reservedNames = Set.fromList-  [ "ado"-  , "case"-  , "class"-  , "data"-  , "derive"-  , "do"-  , "else"-  , "false"-  , "forall"-  , "foreign"-  , "import"-  , "if"-  , "in"-  , "infix"-  , "infixl"-  , "infixr"-  , "instance"-  , "let"-  , "module"-  , "newtype"-  , "of"-  , "true"-  , "type"-  , "where"-  ]--isValidModuleNamespace :: Text -> Bool-isValidModuleNamespace = Text.null . snd . Text.span (\c -> c /= '_' && c /= '\'')---- | This is to keep the @Parser.y@ file ASCII, otherwise @happy@ will break--- in non-unicode locales.------ Related GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/8167-isLeftFatArrow :: Text -> Bool-isLeftFatArrow str = str == "<=" || str == "⇐"
src/Language/PureScript/CodeGen/JS.hs view
@@ -38,7 +38,7 @@ import Language.PureScript.Options import Language.PureScript.PSString (PSString, mkString) import Language.PureScript.Traversals (sndM)-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  import System.FilePath.Posix ((</>)) @@ -50,7 +50,7 @@   => Module Ann   -> Maybe AST   -> m [AST]-moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =+moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreign_ =   rethrow (addHint (ErrorInModule mn)) $ do     let usedNames = concatMap getNames decls     let mnLookup = renameImports usedNames imps@@ -59,6 +59,7 @@     optimized <- traverse (traverse optimize) jsDecls     let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup     let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized+          `S.union` M.keysSet reExps     jsImports <- traverse (importToJs mnLookup)       . filter (flip S.member usedModuleNames)       . (\\ (mn : C.primModules)) $ ordNub $ map snd imps@@ -70,8 +71,10 @@     let moduleBody = header : foreign' ++ jsImports ++ concat optimized     let foreignExps = exps `intersect` foreigns     let standardExps = exps \\ foreignExps+    let reExps' = M.toList (M.withoutKeys reExps (S.fromList C.primModules))     let exps' = AST.ObjectLiteral Nothing $ map (mkString . runIdent &&& AST.Var Nothing . identToJs) standardExps                                ++ map (mkString . runIdent &&& foreignIdent) foreignExps+                               ++ concatMap (reExportPairs mnLookup) reExps'     return $ moduleBody ++ [AST.Assignment Nothing (accessorString "exports" (AST.Var Nothing "module")) exps']    where@@ -80,6 +83,21 @@   getNames :: Bind Ann -> [Ident]   getNames (NonRec _ ident _) = [ident]   getNames (Rec vals) = map (snd . fst) vals++  -- | Generate code in the JavaScript IR for re-exported declarations, prepending+  -- the module name from whence it was imported.+  reExportPairs :: M.Map ModuleName (Ann, ModuleName) -> (ModuleName, [Ident]) -> [(PSString, AST)]+  reExportPairs mnLookup (mn', idents) =+    let toExportedMember :: Ident -> AST+        toExportedMember =+          maybe+            (AST.Var Nothing . identToJs)+            (flip accessor . AST.Var Nothing . moduleNameToJs . snd)+            (M.lookup mn' mnLookup)+    in+      map+        (mkString . runIdent &&& toExportedMember)+        idents    -- | Creates alternative names for each module to ensure they don't collide   -- with declaration names.
− src/Language/PureScript/Comments.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveGeneric #-}---- |--- Defines the types of source code comments----module Language.PureScript.Comments where--import Prelude.Compat-import Codec.Serialise (Serialise)-import Control.DeepSeq (NFData)-import Data.Text (Text)-import GHC.Generics (Generic)--import Data.Aeson.TH--data Comment-  = LineComment Text-  | BlockComment Text-  deriving (Show, Eq, Ord, Generic)--instance NFData Comment-instance Serialise Comment--$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Comment)
− src/Language/PureScript/Constants.hs 
@@ -1,599 +0,0 @@--- | Various constants which refer to things in the Prelude-module Language.PureScript.Constants where--import Prelude.Compat--import Data.String (IsString)-import Language.PureScript.PSString (PSString)-import Language.PureScript.Names---- Operators--($) :: forall a. (IsString a) => a-($) = "$"--apply :: forall a. (IsString a) => a-apply = "apply"--(#) :: forall a. (IsString a) => a-(#) = "#"--applyFlipped :: forall a. (IsString a) => a-applyFlipped = "applyFlipped"--(<>) :: forall a. (IsString a) => a-(<>) = "<>"--(++) :: forall a. (IsString a) => a-(++) = "++"--append :: forall a. (IsString a) => a-append = "append"--(>>=) :: forall a. (IsString a) => a-(>>=) = ">>="--bind :: forall a. (IsString a) => a-bind = "bind"--discard :: forall a. (IsString a) => a-discard = "discard"--pattern Discard :: Qualified (ProperName 'ClassName)-pattern Discard = Qualified (Just ControlBind) (ProperName "Discard")--(+) :: forall a. (IsString a) => a-(+) = "+"--add :: forall a. (IsString a) => a-add = "add"--(-) :: forall a. (IsString a) => a-(-) = "-"--sub :: forall a. (IsString a) => a-sub = "sub"--(*) :: forall a. (IsString a) => a-(*) = "*"--mul :: forall a. (IsString a) => a-mul = "mul"--(/) :: forall a. (IsString a) => a-(/) = "/"--div :: forall a. (IsString a) => a-div = "div"--(%) :: forall a. (IsString a) => a-(%) = "%"--mod :: forall a. (IsString a) => a-mod = "mod"--(<) :: forall a. (IsString a) => a-(<) = "<"--lessThan :: forall a. (IsString a) => a-lessThan = "lessThan"--(>) :: forall a. (IsString a) => a-(>) = ">"--greaterThan :: forall a. (IsString a) => a-greaterThan = "greaterThan"--(<=) :: forall a. (IsString a) => a-(<=) = "<="--lessThanOrEq :: forall a. (IsString a) => a-lessThanOrEq = "lessThanOrEq"--(>=) :: forall a. (IsString a) => a-(>=) = ">="--greaterThanOrEq :: forall a. (IsString a) => a-greaterThanOrEq = "greaterThanOrEq"--(==) :: forall a. (IsString a) => a-(==) = "=="--eq :: forall a. (IsString a) => a-eq = "eq"--eq1 :: forall a. (IsString a) => a-eq1 = "eq1"--(/=) :: forall a. (IsString a) => a-(/=) = "/="--notEq :: forall a. (IsString a) => a-notEq = "notEq"--compare :: forall a. (IsString a) => a-compare = "compare"--compare1 :: forall a. (IsString a) => a-compare1 = "compare1"--(&&) :: forall a. (IsString a) => a-(&&) = "&&"--conj :: forall a. (IsString a) => a-conj = "conj"--(||) :: forall a. (IsString a) => a-(||) = "||"--disj :: forall a. (IsString a) => a-disj = "disj"--unsafeIndex :: forall a. (IsString a) => a-unsafeIndex = "unsafeIndex"--or :: forall a. (IsString a) => a-or = "or"--and :: forall a. (IsString a) => a-and = "and"--xor :: forall a. (IsString a) => a-xor = "xor"--(<<<) :: forall a. (IsString a) => a-(<<<) = "<<<"--compose :: forall a. (IsString a) => a-compose = "compose"--(>>>) :: forall a. (IsString a) => a-(>>>) = ">>>"--composeFlipped :: forall a. (IsString a) => a-composeFlipped = "composeFlipped"--map :: forall a. (IsString a) => a-map = "map"---- Functions--negate :: forall a. (IsString a) => a-negate = "negate"--not :: forall a. (IsString a) => a-not = "not"--shl :: forall a. (IsString a) => a-shl = "shl"--shr :: forall a. (IsString a) => a-shr = "shr"--zshr :: forall a. (IsString a) => a-zshr = "zshr"--complement :: forall a. (IsString a) => a-complement = "complement"---- Prelude Values--zero :: forall a. (IsString a) => a-zero = "zero"--one :: forall a. (IsString a) => a-one = "one"--bottom :: forall a. (IsString a) => a-bottom = "bottom"--top :: forall a. (IsString a) => a-top = "top"--return :: forall a. (IsString a) => a-return = "return"--pure' :: forall a. (IsString a) => a-pure' = "pure"--returnEscaped :: forall a. (IsString a) => a-returnEscaped = "$return"--unit :: forall a. (IsString a) => a-unit = "unit"---- Core lib values--runST :: forall a. (IsString a) => a-runST = "run"--stRefValue :: forall a. (IsString a) => a-stRefValue = "value"--newSTRef :: forall a. (IsString a) => a-newSTRef = "new"--readSTRef :: forall a. (IsString a) => a-readSTRef = "read"--writeSTRef :: forall a. (IsString a) => a-writeSTRef = "write"--modifySTRef :: forall a. (IsString a) => a-modifySTRef = "modify"--mkFn :: forall a. (IsString a) => a-mkFn = "mkFn"--runFn :: forall a. (IsString a) => a-runFn = "runFn"--mkEffFn :: forall a. (IsString a) => a-mkEffFn = "mkEffFn"--runEffFn :: forall a. (IsString a) => a-runEffFn = "runEffFn"--mkEffectFn :: forall a. (IsString a) => a-mkEffectFn = "mkEffectFn"--runEffectFn :: forall a. (IsString a) => a-runEffectFn = "runEffectFn"---- Prim values--undefined :: forall a. (IsString a) => a-undefined = "undefined"---- Type Class Dictionary Names--data EffectDictionaries = EffectDictionaries-  { edApplicativeDict :: PSString-  , edBindDict :: PSString-  , edMonadDict :: PSString-  , edWhile :: PSString-  , edUntil :: PSString-  }--effDictionaries :: EffectDictionaries-effDictionaries = EffectDictionaries-  { edApplicativeDict = "applicativeEff"-  , edBindDict = "bindEff"-  , edMonadDict = "monadEff"-  , edWhile = "whileE"-  , edUntil = "untilE"-  }--effectDictionaries :: EffectDictionaries-effectDictionaries = EffectDictionaries-  { edApplicativeDict = "applicativeEffect"-  , edBindDict = "bindEffect"-  , edMonadDict = "monadEffect"-  , edWhile = "whileE"-  , edUntil = "untilE"-  }--stDictionaries :: EffectDictionaries-stDictionaries = EffectDictionaries-  { edApplicativeDict = "applicativeST"-  , edBindDict = "bindST"-  , edMonadDict = "monadST"-  , edWhile = "while"-  , edUntil = "until"-  }--discardUnitDictionary :: forall a. (IsString a) => a-discardUnitDictionary = "discardUnit"--semiringNumber :: forall a. (IsString a) => a-semiringNumber = "semiringNumber"--semiringInt :: forall a. (IsString a) => a-semiringInt = "semiringInt"--ringNumber :: forall a. (IsString a) => a-ringNumber = "ringNumber"--ringInt :: forall a. (IsString a) => a-ringInt = "ringInt"--moduloSemiringNumber :: forall a. (IsString a) => a-moduloSemiringNumber = "moduloSemiringNumber"--moduloSemiringInt :: forall a. (IsString a) => a-moduloSemiringInt = "moduloSemiringInt"--euclideanRingNumber :: forall a. (IsString a) => a-euclideanRingNumber = "euclideanRingNumber"--euclideanRingInt :: forall a. (IsString a) => a-euclideanRingInt = "euclideanRingInt"--ordBoolean :: forall a. (IsString a) => a-ordBoolean = "ordBoolean"--ordNumber :: forall a. (IsString a) => a-ordNumber = "ordNumber"--ordInt :: forall a. (IsString a) => a-ordInt = "ordInt"--ordString :: forall a. (IsString a) => a-ordString = "ordString"--ordChar :: forall a. (IsString a) => a-ordChar = "ordChar"--eqNumber :: forall a. (IsString a) => a-eqNumber = "eqNumber"--eqInt :: forall a. (IsString a) => a-eqInt = "eqInt"--eqString :: forall a. (IsString a) => a-eqString = "eqString"--eqChar :: forall a. (IsString a) => a-eqChar = "eqChar"--eqBoolean :: forall a. (IsString a) => a-eqBoolean = "eqBoolean"--boundedBoolean :: forall a. (IsString a) => a-boundedBoolean = "boundedBoolean"--booleanAlgebraBoolean :: forall a. (IsString a) => a-booleanAlgebraBoolean = "booleanAlgebraBoolean"--heytingAlgebraBoolean :: forall a. (IsString a) => a-heytingAlgebraBoolean = "heytingAlgebraBoolean"--semigroupString :: forall a. (IsString a) => a-semigroupString = "semigroupString"--semigroupoidFn :: forall a. (IsString a) => a-semigroupoidFn = "semigroupoidFn"---- Generic Deriving--generic :: forall a. (IsString a) => a-generic = "Generic"--toSpine :: forall a. (IsString a) => a-toSpine = "toSpine"--fromSpine :: forall a. (IsString a) => a-fromSpine = "fromSpine"--toSignature :: forall a. (IsString a) => a-toSignature = "toSignature"---- Main module--main :: forall a. (IsString a) => a-main = "main"---- Prim--partial :: forall a. (IsString a) => a-partial = "Partial"--pattern Prim :: ModuleName-pattern Prim = ModuleName "Prim"--pattern Partial :: Qualified (ProperName 'ClassName)-pattern Partial = Qualified (Just Prim) (ProperName "Partial")--pattern Record :: Qualified (ProperName 'TypeName)-pattern Record = Qualified (Just Prim) (ProperName "Record")---- Prim.Boolean--pattern PrimBoolean :: ModuleName-pattern PrimBoolean = ModuleName "Prim.Boolean"--booleanTrue :: Qualified (ProperName 'TypeName)-booleanTrue = Qualified (Just PrimBoolean) (ProperName "True")--booleanFalse :: Qualified (ProperName 'TypeName)-booleanFalse = Qualified (Just PrimBoolean) (ProperName "False")---- Prim.Ordering--pattern PrimOrdering :: ModuleName-pattern PrimOrdering = ModuleName "Prim.Ordering"--orderingLT :: Qualified (ProperName 'TypeName)-orderingLT = Qualified (Just PrimOrdering) (ProperName "LT")--orderingEQ :: Qualified (ProperName 'TypeName)-orderingEQ = Qualified (Just PrimOrdering) (ProperName "EQ")--orderingGT :: Qualified (ProperName 'TypeName)-orderingGT = Qualified (Just PrimOrdering) (ProperName "GT")---- Prim.Row--pattern PrimRow :: ModuleName-pattern PrimRow = ModuleName "Prim.Row"--pattern RowUnion :: Qualified (ProperName 'ClassName)-pattern RowUnion = Qualified (Just PrimRow) (ProperName "Union")--pattern RowNub :: Qualified (ProperName 'ClassName)-pattern RowNub = Qualified (Just PrimRow) (ProperName "Nub")--pattern RowCons :: Qualified (ProperName 'ClassName)-pattern RowCons = Qualified (Just PrimRow) (ProperName "Cons")--pattern RowLacks :: Qualified (ProperName 'ClassName)-pattern RowLacks = Qualified (Just PrimRow) (ProperName "Lacks")---- Prim.RowList--pattern PrimRowList :: ModuleName-pattern PrimRowList = ModuleName "Prim.RowList"--pattern RowToList :: Qualified (ProperName 'ClassName)-pattern RowToList = Qualified (Just PrimRowList) (ProperName "RowToList")--pattern RowListNil :: Qualified (ProperName 'TypeName)-pattern RowListNil = Qualified (Just PrimRowList) (ProperName "Nil")--pattern RowListCons :: Qualified (ProperName 'TypeName)-pattern RowListCons = Qualified (Just PrimRowList) (ProperName "Cons")---- Prim.Symbol--pattern PrimSymbol :: ModuleName-pattern PrimSymbol = ModuleName "Prim.Symbol"--pattern SymbolCompare :: Qualified (ProperName 'ClassName)-pattern SymbolCompare = Qualified (Just PrimSymbol) (ProperName "Compare")--pattern SymbolAppend :: Qualified (ProperName 'ClassName)-pattern SymbolAppend = Qualified (Just PrimSymbol) (ProperName "Append")--pattern SymbolCons :: Qualified (ProperName 'ClassName)-pattern SymbolCons = Qualified (Just PrimSymbol) (ProperName "Cons")---- Prim.TypeError--pattern PrimTypeError :: ModuleName-pattern PrimTypeError = ModuleName "Prim.TypeError"--pattern Fail :: Qualified (ProperName 'ClassName)-pattern Fail = Qualified (Just PrimTypeError) (ProperName "Fail")--pattern Warn :: Qualified (ProperName 'ClassName)-pattern Warn = Qualified (Just PrimTypeError) (ProperName "Warn")--primModules :: [ModuleName]-primModules = [Prim, PrimBoolean, PrimOrdering, PrimRow, PrimRowList, PrimSymbol, PrimTypeError]---- Data.Symbol--pattern DataSymbol :: ModuleName-pattern DataSymbol = ModuleName "Data.Symbol"--pattern IsSymbol :: Qualified (ProperName 'ClassName)-pattern IsSymbol = Qualified (Just DataSymbol) (ProperName "IsSymbol")--typ :: forall a. (IsString a) => a-typ = "Type"--kindBoolean :: forall a. (IsString a) => a-kindBoolean = "Boolean"--kindOrdering :: forall a. (IsString a) => a-kindOrdering = "Ordering"--kindRowList :: forall a. (IsString a) => a-kindRowList = "RowList"--symbol :: forall a. (IsString a) => a-symbol = "Symbol"--doc :: forall a. (IsString a) => a-doc = "Doc"---- Modules--prim :: forall a. (IsString a) => a-prim = "Prim"--moduleBoolean :: forall a. (IsString a) => a-moduleBoolean = "Boolean"--moduleOrdering :: forall a. (IsString a) => a-moduleOrdering = "Ordering"--moduleRow :: forall a. (IsString a) => a-moduleRow = "Row"--moduleRowList :: forall a. (IsString a) => a-moduleRowList = "RowList"--moduleSymbol :: forall a. (IsString a) => a-moduleSymbol = "Symbol"--typeError :: forall a. (IsString a) => a-typeError = "TypeError"--prelude :: forall a. (IsString a) => a-prelude = "Prelude"--dataArray :: forall a. (IsString a) => a-dataArray = "Data_Array"--eff :: forall a. (IsString a) => a-eff = "Control_Monad_Eff"--effect :: forall a. (IsString a) => a-effect = "Effect"--st :: forall a. (IsString a) => a-st = "Control_Monad_ST_Internal"--controlApplicative :: forall a. (IsString a) => a-controlApplicative = "Control_Applicative"--controlSemigroupoid :: forall a. (IsString a) => a-controlSemigroupoid = "Control_Semigroupoid"--pattern ControlBind :: ModuleName-pattern ControlBind = ModuleName "Control.Bind"--controlBind :: forall a. (IsString a) => a-controlBind = "Control_Bind"--controlMonadEffUncurried :: forall a. (IsString a) => a-controlMonadEffUncurried = "Control_Monad_Eff_Uncurried"--effectUncurried :: forall a. (IsString a) => a-effectUncurried = "Effect_Uncurried"--dataBounded :: forall a. (IsString a) => a-dataBounded = "Data_Bounded"--dataSemigroup :: forall a. (IsString a) => a-dataSemigroup = "Data_Semigroup"--dataHeytingAlgebra :: forall a. (IsString a) => a-dataHeytingAlgebra = "Data_HeytingAlgebra"--dataEq :: forall a. (IsString a) => a-dataEq = "Data_Eq"--dataOrd :: forall a. (IsString a) => a-dataOrd = "Data_Ord"--dataSemiring :: forall a. (IsString a) => a-dataSemiring = "Data_Semiring"--dataRing :: forall a. (IsString a) => a-dataRing = "Data_Ring"--dataEuclideanRing :: forall a. (IsString a) => a-dataEuclideanRing = "Data_EuclideanRing"--dataFunction :: forall a. (IsString a) => a-dataFunction = "Data_Function"--dataFunctionUncurried :: forall a. (IsString a) => a-dataFunctionUncurried = "Data_Function_Uncurried"--dataIntBits :: forall a. (IsString a) => a-dataIntBits = "Data_Int_Bits"--partialUnsafe :: forall a. (IsString a) => a-partialUnsafe = "Partial_Unsafe"--unsafePartial :: forall a. (IsString a) => a-unsafePartial = "unsafePartial"--unsafeCoerce :: forall a. (IsString a) => a-unsafeCoerce = "Unsafe_Coerce"--unsafeCoerceFn :: forall a. (IsString a) => a-unsafeCoerceFn = "unsafeCoerce"
+ src/Language/PureScript/Constants/Data/Generic/Rep.hs view
@@ -0,0 +1,40 @@+module Language.PureScript.Constants.Data.Generic.Rep where++import Prelude.Compat+import Language.PureScript.Names++pattern DataGenericRep :: ModuleName+pattern DataGenericRep = ModuleName "Data.Generic.Rep"++pattern Generic :: Qualified (ProperName 'ClassName)+pattern Generic = Qualified (Just DataGenericRep) (ProperName "Generic")++to :: Qualified Ident+to = Qualified (Just DataGenericRep) (Ident "to")++from :: Qualified Ident+from = Qualified (Just DataGenericRep) (Ident "from")++pattern NoConstructors :: Qualified (ProperName a)+pattern NoConstructors = Qualified (Just DataGenericRep) (ProperName "NoConstructors")++pattern NoArguments :: Qualified (ProperName a)+pattern NoArguments = Qualified (Just DataGenericRep) (ProperName "NoArguments")++pattern Sum :: Qualified (ProperName a)+pattern Sum = Qualified (Just DataGenericRep) (ProperName "Sum")++pattern Inl :: Qualified (ProperName a)+pattern Inl = Qualified (Just DataGenericRep) (ProperName "Inl")++pattern Inr :: Qualified (ProperName a)+pattern Inr = Qualified (Just DataGenericRep) (ProperName "Inr")++pattern Product :: Qualified (ProperName a)+pattern Product = Qualified (Just DataGenericRep) (ProperName "Product")++pattern Constructor :: Qualified (ProperName a)+pattern Constructor = Qualified (Just DataGenericRep) (ProperName "Constructor")++pattern Argument :: Qualified (ProperName a)+pattern Argument = Qualified (Just DataGenericRep) (ProperName "Argument")
+ src/Language/PureScript/Constants/Data/Newtype.hs view
@@ -0,0 +1,7 @@+module Language.PureScript.Constants.Data.Newtype where++import Prelude.Compat+import Language.PureScript.Names++pattern Newtype :: Qualified (ProperName 'ClassName)+pattern Newtype = Qualified (Just (ModuleName "Data.Newtype")) (ProperName "Newtype")
+ src/Language/PureScript/Constants/Prelude.hs view
@@ -0,0 +1,455 @@+-- | Various constants which refer to things in the Prelude+module Language.PureScript.Constants.Prelude where++import Prelude.Compat++import Data.String (IsString)+import Language.PureScript.PSString (PSString)+import Language.PureScript.Names++-- Operators++($) :: forall a. (IsString a) => a+($) = "$"++apply :: forall a. (IsString a) => a+apply = "apply"++(#) :: forall a. (IsString a) => a+(#) = "#"++applyFlipped :: forall a. (IsString a) => a+applyFlipped = "applyFlipped"++(<>) :: forall a. (IsString a) => a+(<>) = "<>"++(++) :: forall a. (IsString a) => a+(++) = "++"++append :: forall a. (IsString a) => a+append = "append"++(>>=) :: forall a. (IsString a) => a+(>>=) = ">>="++bind :: forall a. (IsString a) => a+bind = "bind"++discard :: forall a. (IsString a) => a+discard = "discard"++pattern Discard :: Qualified (ProperName 'ClassName)+pattern Discard = Qualified (Just ControlBind) (ProperName "Discard")++(+) :: forall a. (IsString a) => a+(+) = "+"++add :: forall a. (IsString a) => a+add = "add"++(-) :: forall a. (IsString a) => a+(-) = "-"++sub :: forall a. (IsString a) => a+sub = "sub"++(*) :: forall a. (IsString a) => a+(*) = "*"++mul :: forall a. (IsString a) => a+mul = "mul"++(/) :: forall a. (IsString a) => a+(/) = "/"++div :: forall a. (IsString a) => a+div = "div"++(%) :: forall a. (IsString a) => a+(%) = "%"++mod :: forall a. (IsString a) => a+mod = "mod"++(<) :: forall a. (IsString a) => a+(<) = "<"++lessThan :: forall a. (IsString a) => a+lessThan = "lessThan"++(>) :: forall a. (IsString a) => a+(>) = ">"++greaterThan :: forall a. (IsString a) => a+greaterThan = "greaterThan"++(<=) :: forall a. (IsString a) => a+(<=) = "<="++lessThanOrEq :: forall a. (IsString a) => a+lessThanOrEq = "lessThanOrEq"++(>=) :: forall a. (IsString a) => a+(>=) = ">="++greaterThanOrEq :: forall a. (IsString a) => a+greaterThanOrEq = "greaterThanOrEq"++(==) :: forall a. (IsString a) => a+(==) = "=="++eq :: forall a. (IsString a) => a+eq = "eq"++eq1 :: forall a. (IsString a) => a+eq1 = "eq1"++(/=) :: forall a. (IsString a) => a+(/=) = "/="++notEq :: forall a. (IsString a) => a+notEq = "notEq"++compare :: forall a. (IsString a) => a+compare = "compare"++compare1 :: forall a. (IsString a) => a+compare1 = "compare1"++(&&) :: forall a. (IsString a) => a+(&&) = "&&"++conj :: forall a. (IsString a) => a+conj = "conj"++(||) :: forall a. (IsString a) => a+(||) = "||"++disj :: forall a. (IsString a) => a+disj = "disj"++unsafeIndex :: forall a. (IsString a) => a+unsafeIndex = "unsafeIndex"++or :: forall a. (IsString a) => a+or = "or"++and :: forall a. (IsString a) => a+and = "and"++xor :: forall a. (IsString a) => a+xor = "xor"++(<<<) :: forall a. (IsString a) => a+(<<<) = "<<<"++compose :: forall a. (IsString a) => a+compose = "compose"++(>>>) :: forall a. (IsString a) => a+(>>>) = ">>>"++composeFlipped :: forall a. (IsString a) => a+composeFlipped = "composeFlipped"++map :: forall a. (IsString a) => a+map = "map"++-- Functions++negate :: forall a. (IsString a) => a+negate = "negate"++not :: forall a. (IsString a) => a+not = "not"++shl :: forall a. (IsString a) => a+shl = "shl"++shr :: forall a. (IsString a) => a+shr = "shr"++zshr :: forall a. (IsString a) => a+zshr = "zshr"++complement :: forall a. (IsString a) => a+complement = "complement"++-- Prelude Values++zero :: forall a. (IsString a) => a+zero = "zero"++one :: forall a. (IsString a) => a+one = "one"++bottom :: forall a. (IsString a) => a+bottom = "bottom"++top :: forall a. (IsString a) => a+top = "top"++return :: forall a. (IsString a) => a+return = "return"++pure' :: forall a. (IsString a) => a+pure' = "pure"++returnEscaped :: forall a. (IsString a) => a+returnEscaped = "$return"++unit :: forall a. (IsString a) => a+unit = "unit"++-- Core lib values++runST :: forall a. (IsString a) => a+runST = "run"++stRefValue :: forall a. (IsString a) => a+stRefValue = "value"++newSTRef :: forall a. (IsString a) => a+newSTRef = "new"++readSTRef :: forall a. (IsString a) => a+readSTRef = "read"++writeSTRef :: forall a. (IsString a) => a+writeSTRef = "write"++modifySTRef :: forall a. (IsString a) => a+modifySTRef = "modify"++mkFn :: forall a. (IsString a) => a+mkFn = "mkFn"++runFn :: forall a. (IsString a) => a+runFn = "runFn"++mkEffFn :: forall a. (IsString a) => a+mkEffFn = "mkEffFn"++runEffFn :: forall a. (IsString a) => a+runEffFn = "runEffFn"++mkEffectFn :: forall a. (IsString a) => a+mkEffectFn = "mkEffectFn"++runEffectFn :: forall a. (IsString a) => a+runEffectFn = "runEffectFn"++-- Type Class Dictionary Names++data EffectDictionaries = EffectDictionaries+  { edApplicativeDict :: PSString+  , edBindDict :: PSString+  , edMonadDict :: PSString+  , edWhile :: PSString+  , edUntil :: PSString+  }++effDictionaries :: EffectDictionaries+effDictionaries = EffectDictionaries+  { edApplicativeDict = "applicativeEff"+  , edBindDict = "bindEff"+  , edMonadDict = "monadEff"+  , edWhile = "whileE"+  , edUntil = "untilE"+  }++effectDictionaries :: EffectDictionaries+effectDictionaries = EffectDictionaries+  { edApplicativeDict = "applicativeEffect"+  , edBindDict = "bindEffect"+  , edMonadDict = "monadEffect"+  , edWhile = "whileE"+  , edUntil = "untilE"+  }++stDictionaries :: EffectDictionaries+stDictionaries = EffectDictionaries+  { edApplicativeDict = "applicativeST"+  , edBindDict = "bindST"+  , edMonadDict = "monadST"+  , edWhile = "while"+  , edUntil = "until"+  }++discardUnitDictionary :: forall a. (IsString a) => a+discardUnitDictionary = "discardUnit"++semiringNumber :: forall a. (IsString a) => a+semiringNumber = "semiringNumber"++semiringInt :: forall a. (IsString a) => a+semiringInt = "semiringInt"++ringNumber :: forall a. (IsString a) => a+ringNumber = "ringNumber"++ringInt :: forall a. (IsString a) => a+ringInt = "ringInt"++moduloSemiringNumber :: forall a. (IsString a) => a+moduloSemiringNumber = "moduloSemiringNumber"++moduloSemiringInt :: forall a. (IsString a) => a+moduloSemiringInt = "moduloSemiringInt"++euclideanRingNumber :: forall a. (IsString a) => a+euclideanRingNumber = "euclideanRingNumber"++euclideanRingInt :: forall a. (IsString a) => a+euclideanRingInt = "euclideanRingInt"++ordBoolean :: forall a. (IsString a) => a+ordBoolean = "ordBoolean"++ordNumber :: forall a. (IsString a) => a+ordNumber = "ordNumber"++ordInt :: forall a. (IsString a) => a+ordInt = "ordInt"++ordString :: forall a. (IsString a) => a+ordString = "ordString"++ordChar :: forall a. (IsString a) => a+ordChar = "ordChar"++eqNumber :: forall a. (IsString a) => a+eqNumber = "eqNumber"++eqInt :: forall a. (IsString a) => a+eqInt = "eqInt"++eqString :: forall a. (IsString a) => a+eqString = "eqString"++eqChar :: forall a. (IsString a) => a+eqChar = "eqChar"++eqBoolean :: forall a. (IsString a) => a+eqBoolean = "eqBoolean"++boundedBoolean :: forall a. (IsString a) => a+boundedBoolean = "boundedBoolean"++booleanAlgebraBoolean :: forall a. (IsString a) => a+booleanAlgebraBoolean = "booleanAlgebraBoolean"++heytingAlgebraBoolean :: forall a. (IsString a) => a+heytingAlgebraBoolean = "heytingAlgebraBoolean"++semigroupString :: forall a. (IsString a) => a+semigroupString = "semigroupString"++semigroupoidFn :: forall a. (IsString a) => a+semigroupoidFn = "semigroupoidFn"++-- Generic Deriving++generic :: forall a. (IsString a) => a+generic = "Generic"++toSpine :: forall a. (IsString a) => a+toSpine = "toSpine"++fromSpine :: forall a. (IsString a) => a+fromSpine = "fromSpine"++toSignature :: forall a. (IsString a) => a+toSignature = "toSignature"++-- Main module++main :: forall a. (IsString a) => a+main = "main"++-- Data.Symbol++pattern DataSymbol :: ModuleName+pattern DataSymbol = ModuleName "Data.Symbol"++pattern IsSymbol :: Qualified (ProperName 'ClassName)+pattern IsSymbol = Qualified (Just DataSymbol) (ProperName "IsSymbol")++prelude :: forall a. (IsString a) => a+prelude = "Prelude"++dataArray :: forall a. (IsString a) => a+dataArray = "Data_Array"++eff :: forall a. (IsString a) => a+eff = "Control_Monad_Eff"++effect :: forall a. (IsString a) => a+effect = "Effect"++st :: forall a. (IsString a) => a+st = "Control_Monad_ST_Internal"++controlApplicative :: forall a. (IsString a) => a+controlApplicative = "Control_Applicative"++controlSemigroupoid :: forall a. (IsString a) => a+controlSemigroupoid = "Control_Semigroupoid"++pattern ControlBind :: ModuleName+pattern ControlBind = ModuleName "Control.Bind"++controlBind :: forall a. (IsString a) => a+controlBind = "Control_Bind"++controlMonadEffUncurried :: forall a. (IsString a) => a+controlMonadEffUncurried = "Control_Monad_Eff_Uncurried"++effectUncurried :: forall a. (IsString a) => a+effectUncurried = "Effect_Uncurried"++dataBounded :: forall a. (IsString a) => a+dataBounded = "Data_Bounded"++dataSemigroup :: forall a. (IsString a) => a+dataSemigroup = "Data_Semigroup"++dataHeytingAlgebra :: forall a. (IsString a) => a+dataHeytingAlgebra = "Data_HeytingAlgebra"++dataEq :: forall a. (IsString a) => a+dataEq = "Data_Eq"++dataOrd :: forall a. (IsString a) => a+dataOrd = "Data_Ord"++dataSemiring :: forall a. (IsString a) => a+dataSemiring = "Data_Semiring"++dataRing :: forall a. (IsString a) => a+dataRing = "Data_Ring"++dataEuclideanRing :: forall a. (IsString a) => a+dataEuclideanRing = "Data_EuclideanRing"++dataFunction :: forall a. (IsString a) => a+dataFunction = "Data_Function"++dataFunctionUncurried :: forall a. (IsString a) => a+dataFunctionUncurried = "Data_Function_Uncurried"++dataIntBits :: forall a. (IsString a) => a+dataIntBits = "Data_Int_Bits"++partialUnsafe :: forall a. (IsString a) => a+partialUnsafe = "Partial_Unsafe"++unsafePartial :: forall a. (IsString a) => a+unsafePartial = "unsafePartial"++unsafeCoerce :: forall a. (IsString a) => a+unsafeCoerce = "Unsafe_Coerce"++unsafeCoerceFn :: forall a. (IsString a) => a+unsafeCoerceFn = "unsafeCoerce"
src/Language/PureScript/CoreFn/Desugar.hs view
@@ -28,7 +28,7 @@ import Language.PureScript.Types import Language.PureScript.PSString (mkString) import qualified Language.PureScript.AST as A-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  -- | Desugars a module from AST to CoreFn representation. moduleToCoreFn :: Environment -> A.Module -> Module Ann@@ -38,12 +38,23 @@   let imports = mapMaybe importToCoreFn decls ++ fmap (ssAnn modSS,) (findQualModules decls)       imports' = dedupeImports imports       exps' = ordNub $ concatMap exportToCoreFn exps+      reExps = M.map ordNub $ M.unionsWith (++) (mapMaybe (fmap reExportsToCoreFn . toReExportRef) exps)       externs = ordNub $ mapMaybe externToCoreFn decls       decls' = concatMap declToCoreFn decls-  in Module modSS coms mn (spanName modSS) imports' exps' externs decls'-+  in Module modSS coms mn (spanName modSS) imports' exps' reExps externs decls'   where+  -- | Creates a map from a module name to the re-export references defined in+  -- that module.+  reExportsToCoreFn :: (ModuleName, A.DeclarationRef) -> M.Map ModuleName [Ident]+  reExportsToCoreFn (mn', ref') = M.singleton mn' (exportToCoreFn ref') +  toReExportRef :: A.DeclarationRef -> Maybe (ModuleName, A.DeclarationRef)+  toReExportRef (A.ReExportRef _ src ref) =+      fmap+        (, ref)+        (A.exportSourceImportedFrom src)+  toReExportRef _ = Nothing+   -- | Remove duplicate imports   dedupeImports :: [(Ann, ModuleName)] -> [(Ann, ModuleName)]   dedupeImports = fmap swap . M.toList . M.fromListWith const . fmap swap@@ -238,10 +249,14 @@ -- constructor, instances and values are flattened into one list. exportToCoreFn :: A.DeclarationRef -> [Ident] exportToCoreFn (A.TypeRef _ _ (Just dctors)) = fmap properToIdent dctors+exportToCoreFn (A.TypeRef _ _ Nothing) = []+exportToCoreFn (A.TypeOpRef _ _) = [] exportToCoreFn (A.ValueRef _ name) = [name]+exportToCoreFn (A.ValueOpRef _ _) = [] exportToCoreFn (A.TypeClassRef _ name) = [properToIdent name] exportToCoreFn (A.TypeInstanceRef _ name) = [name]-exportToCoreFn _ = []+exportToCoreFn (A.ModuleRef _ _) = []+exportToCoreFn (A.ReExportRef _ _ _) = []  -- | Makes a typeclass dictionary constructor function. The returned expression -- is a function that accepts the superclass instances and member
src/Language/PureScript/CoreFn/FromJSON.hs view
@@ -11,6 +11,7 @@  import           Data.Aeson import           Data.Aeson.Types (Parser, Value, listParser)+import qualified Data.Map.Strict as M import           Data.Text (Text) import qualified Data.Text as T import qualified Data.Vector as V@@ -124,6 +125,7 @@     moduleSourceSpan <- o .: "sourceSpan" >>= sourceSpanFromJSON modulePath     moduleImports <- o .: "imports" >>= listParser (importFromJSON modulePath)     moduleExports <- o .: "exports" >>= listParser identFromJSON+    moduleReExports <- o .: "reExports" >>= reExportsFromJSON     moduleDecls <- o .: "decls" >>= listParser (bindFromJSON modulePath)     moduleForeign <- o .: "foreign" >>= listParser identFromJSON     moduleComments <- o .: "comments" >>= listParser parseJSON@@ -141,6 +143,9 @@       ann <- o .: "annotation" >>= annFromJSON modulePath       mn  <- o .: "moduleName" >>= moduleNameFromJSON       return (ann, mn))++  reExportsFromJSON :: Value -> Parser (M.Map ModuleName [Ident])+  reExportsFromJSON = fmap (M.map (map Ident)) . parseJSON  bindFromJSON :: FilePath -> Value -> Parser (Bind Ann) bindFromJSON modulePath = withObject "Bind" bindFromObj
src/Language/PureScript/CoreFn/Meta.hs view
@@ -38,10 +38,10 @@ -- data ConstructorType   -- |-  -- The constructor is for a type with a single construcor+  -- The constructor is for a type with a single constructor   --   = ProductType   -- |-  -- The constructor is for a type with multiple construcors+  -- The constructor is for a type with multiple constructors   --   | SumType deriving (Show, Eq, Ord)
src/Language/PureScript/CoreFn/Module.hs view
@@ -2,6 +2,8 @@  import Prelude.Compat +import Data.Map.Strict (Map)+ import Language.PureScript.AST.SourcePos import Language.PureScript.Comments import Language.PureScript.CoreFn.Expr@@ -10,9 +12,6 @@ -- | -- The CoreFn module representation ----- The json CoreFn representation does not contain type information.  When--- parsing it one gets back `ModuleT () Ann` rathern than `ModuleT Type Ann`,--- which is enough for `moduleToJs`. data Module a = Module   { moduleSourceSpan :: SourceSpan   , moduleComments :: [Comment]@@ -20,6 +19,7 @@   , modulePath :: FilePath   , moduleImports :: [(a, ModuleName)]   , moduleExports :: [Ident]+  , moduleReExports :: Map ModuleName [Ident]   , moduleForeign :: [Ident]   , moduleDecls :: [Bind a]   } deriving (Show)
src/Language/PureScript/CoreFn/Optimizer.hs view
@@ -12,7 +12,7 @@ import Language.PureScript.Names (Ident(UnusedIdent), Qualified(Qualified)) import Language.PureScript.Label import Language.PureScript.Types-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  -- | -- CoreFn optimization pass.@@ -42,7 +42,7 @@   collect row   where     collect :: Type a -> Maybe [Label]-    collect (REmpty _) = Just []+    collect (REmptyKinded _ _) = Just []     collect (RCons _ l _ r) = collect r >>= return . (l :)     collect _ = Nothing closedRecordFields _ = Nothing
src/Language/PureScript/CoreFn/ToJSON.hs view
@@ -11,6 +11,7 @@  import           Control.Arrow ((***)) import           Data.Either (isLeft)+import qualified Data.Map.Strict as M import           Data.Maybe (maybe) import           Data.Aeson import           Data.Version (Version, showVersion)@@ -109,6 +110,7 @@   , T.pack "modulePath" .= toJSON (modulePath m)   , T.pack "imports"    .= map importToJSON (moduleImports m)   , T.pack "exports"    .= map identToJSON (moduleExports m)+  , T.pack "reExports"  .= reExportsToJSON (moduleReExports m)   , T.pack "foreign"    .= map identToJSON (moduleForeign m)   , T.pack "decls"      .= map bindToJSON (moduleDecls m)   , T.pack "builtWith"  .= toJSON (showVersion v)@@ -120,6 +122,9 @@     [ T.pack "annotation" .= annToJSON ann     , T.pack "moduleName" .= moduleNameToJSON mn     ]++  reExportsToJSON :: M.Map ModuleName [Ident] -> Value+  reExportsToJSON = toJSON . M.map (map runIdent)  bindToJSON :: Bind Ann -> Value bindToJSON (NonRec ann n e)
src/Language/PureScript/CoreImp/Optimizer/Inliner.hs view
@@ -25,7 +25,8 @@ import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common import Language.PureScript.AST (SourceSpan(..))-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Prim as C  -- TODO: Potential bug: -- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs view
@@ -11,7 +11,7 @@ import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common import Language.PureScript.PSString (mkString)-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C  -- | Inline type class dictionaries for >>= and return for the Eff monad --
src/Language/PureScript/CoreImp/Optimizer/TCO.hs view
@@ -4,7 +4,7 @@ import Prelude.Compat  import Data.Text (Text)-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C import Language.PureScript.CoreImp.AST import Language.PureScript.AST.SourcePos (SourceSpan) import Safe (headDef, tailSafe)
src/Language/PureScript/CoreImp/Optimizer/Unused.hs view
@@ -8,7 +8,7 @@  import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  removeCodeAfterReturnStatements :: AST -> AST removeCodeAfterReturnStatements = everywhere (removeFromBlock go)
− src/Language/PureScript/Crash.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ImplicitParams #-}--module Language.PureScript.Crash where--import Prelude.Compat--import qualified GHC.Stack---- | A compatibility wrapper for the @GHC.Stack.HasCallStack@ constraint.-#if __GLASGOW_HASKELL__ >= 800-type HasCallStack = GHC.Stack.HasCallStack-#elif MIN_VERSION_GLASGOW_HASKELL(7,10,2,0)-type HasCallStack = (?callStack :: GHC.Stack.CallStack)-#else-import GHC.Exts (Constraint)--- CallStack wasn't present in GHC 7.10.1-type HasCallStack = (() :: Constraint)-#endif---- | Exit with an error message and a crash report link.-internalError :: HasCallStack => String -> a-internalError =-  error-  . ("An internal error occurred during compilation: " ++)-  . (++ "\nPlease report this at https://github.com/purescript/purescript/issues")
src/Language/PureScript/Docs/AsHtml.hs view
@@ -17,7 +17,7 @@ import Prelude import Control.Category ((>>>)) import Control.Monad (unless)-import Data.Bifunctor (first)+import Data.Bifunctor (bimap) import Data.Char (isUpper) import Data.Either (isRight) import qualified Data.List.NonEmpty as NE@@ -225,7 +225,7 @@    runParser :: CST.Parser a -> Text -> Either String a   runParser p' =-    first (CST.prettyPrintError . NE.head)+    bimap (CST.prettyPrintError . NE.head) snd       . CST.runTokenParser p'       . CST.lex @@ -248,7 +248,6 @@   prefix = case ns of     TypeLevel -> "#t:"     ValueLevel -> "#v:"-    KindLevel -> "#k:"    -- TODO   escape = id
src/Language/PureScript/Docs/Convert.hs view
@@ -39,10 +39,8 @@   P.Environment ->   P.Module ->   m Module-convertModule externs env checkEnv m =-  partiallyDesugar externs env [m] >>= \case-    [m'] -> pure (insertValueTypes checkEnv (convertSingleModule m'))-    _ -> P.internalError "partiallyDesugar did not return a singleton"+convertModule externs env checkEnv =+  fmap (insertValueTypes checkEnv . convertSingleModule) . partiallyDesugar externs env  -- | -- Updates all the types of the ValueDeclarations inside the module based on@@ -78,7 +76,7 @@  runParser :: CST.Parser a -> Text -> Either String a runParser p =-  first (CST.prettyPrintError . NE.head)+  bimap (CST.prettyPrintError . NE.head) snd     . CST.runTokenParser p     . CST.lex @@ -90,17 +88,17 @@   (MonadError P.MultipleErrors m) =>   [P.ExternsFile] ->   P.Env ->-  [P.Module] ->-  m [P.Module]+  P.Module ->+  m P.Module partiallyDesugar externs env = evalSupplyT 0 . desugar'   where   desugar' =-    traverse P.desugarDoModule-      >=> traverse P.desugarAdoModule-      >=> map P.desugarLetPatternModule-      >>> traverse P.desugarCasesModule-      >=> traverse P.desugarTypeDeclarationsModule-      >=> fmap fst . runWriterT . P.desugarImports env+    P.desugarDoModule+      >=> P.desugarAdoModule+      >=> P.desugarLetPatternModule+      >>> P.desugarCasesModule+      >=> P.desugarTypeDeclarationsModule+      >=> fmap fst . runWriterT . flip evalStateT (env, mempty) . P.desugarImports       >=> P.rebracketFiltered isInstanceDecl externs    isInstanceDecl (P.TypeInstanceDeclaration {}) = True
src/Language/PureScript/Docs/Convert/ReExports.hs view
@@ -68,7 +68,7 @@    traversalOrder :: [P.ModuleName]   traversalOrder =-    case P.sortModules externsSignature externs of+    case P.sortModules P.Transitive externsSignature externs of       Right (es, _) -> map P.efModuleName es       Left errs -> internalError $         "failed to sortModules: " ++@@ -135,14 +135,13 @@   typeClasses <- collect lookupTypeClassDeclaration expTCs   types <- collect lookupTypeDeclaration expTypes   typeOps <- collect lookupTypeOpDeclaration expTypeOps-  kinds <- collect lookupKindDeclaration expKinds    (vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses    let filteredTypes = filterDataConstructors expCtors types   let filteredClasses = filterTypeClassMembers (Map.keys expVals) classes -  pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps, kinds]))+  pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps]))    where @@ -171,9 +170,6 @@   expTypeOps :: Map (P.OpName 'P.TypeOpName) P.ExportSource   expTypeOps = mkExportMap P.getTypeOpRef -  expKinds :: Map (P.ProperName 'P.KindName) P.ExportSource-  expKinds = mkExportMap P.getKindRef-   mkExportMap :: Ord name => (P.DeclarationRef -> Maybe name) -> Map name P.ExportSource   mkExportMap f =     Map.fromList $@@ -183,6 +179,7 @@   expCtors = concatMap (fromMaybe [] . (>>= snd) . P.getTypeRef . snd) reExports  lookupValueDeclaration ::+  forall m.   (MonadState (Map P.ModuleName Module) m,    MonadReader P.ModuleName m) =>   P.ModuleName ->@@ -194,6 +191,7 @@     rs =       filter (\d -> declTitle d == P.showIdent ident                     && (isValue d || isValueAlias d)) decls+    errOther :: Show a => a -> m b     errOther other =       internalErrorInModule         ("lookupValueDeclaration: unexpected result:\n" ++@@ -312,24 +310,6 @@          ++ show tyClass ++ ": "          ++ (unlines . map show) other) -lookupKindDeclaration-  :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)-  => P.ModuleName-  -> P.ProperName 'P.KindName-  -> m (P.ModuleName, [Declaration])-lookupKindDeclaration importedFrom kind = do-  decls <- lookupModuleDeclarations "lookupKindDeclaration" importedFrom-  let-    ds = filter (\d -> declTitle d == P.runProperName kind-                       && isKind d)-                decls-  case ds of-    [d] ->-      pure (importedFrom, [d])-    other ->-      internalErrorInModule-        ("lookupKindDeclaration: unexpected result: " ++ show other)- -- | -- Get the full list of declarations for a particular module out of the -- state, or raise an internal error if it is not there.@@ -530,7 +510,7 @@ typeClassConstraintFor Declaration{..} =   case declInfo of     TypeClassDeclaration tyArgs _ _ ->-      Just (P.Constraint () (P.Qualified Nothing (P.ProperName declTitle)) (mkConstraint tyArgs) Nothing)+      Just (P.Constraint () (P.Qualified Nothing (P.ProperName declTitle)) [] (mkConstraint tyArgs) Nothing)     _ ->       Nothing   where
src/Language/PureScript/Docs/Convert/Single.hs view
@@ -93,7 +93,6 @@ getDeclarationTitle (P.ExternDeclaration _ name _) = Just (P.showIdent name) getDeclarationTitle (P.DataDeclaration _ _ name _ _) = Just (P.runProperName name) getDeclarationTitle (P.ExternDataDeclaration _ name _) = Just (P.runProperName name)-getDeclarationTitle (P.ExternKindDeclaration _ name) = Just (P.runProperName name) getDeclarationTitle (P.TypeSynonymDeclaration _ name _ _) = Just (P.runProperName name) getDeclarationTitle (P.TypeClassDeclaration _ name _ _ _ _) = Just (P.runProperName name) getDeclarationTitle (P.TypeInstanceDeclaration _ _ _ name _ _ _ _) = Just (P.showIdent name)@@ -133,8 +132,6 @@     ChildDeclaration (P.runProperName dataCtorName) (convertComments $ snd dataCtorAnn) Nothing (ChildDataConstructor (fmap (($> ()) . snd) dataCtorFields)) convertDeclaration (P.ExternDataDeclaration sa _ kind') title =   basicDeclaration sa title (ExternDataDeclaration (kind' $> ()))-convertDeclaration (P.ExternKindDeclaration sa _) title =-  basicDeclaration sa title ExternKindDeclaration convertDeclaration (P.TypeSynonymDeclaration sa _ args ty) title =   basicDeclaration sa title (TypeSynonymDeclaration (fmap (fmap (fmap ($> ()))) args) (ty $> ())) convertDeclaration (P.TypeClassDeclaration sa _ args implies fundeps ds) title =
src/Language/PureScript/Docs/Prim.hs view
@@ -11,7 +11,6 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Map as Map-import qualified Data.Set as Set import Language.PureScript.Docs.Types  import qualified Language.PureScript.Crash as P@@ -22,6 +21,7 @@ primModules =   [ primDocsModule   , primBooleanDocsModule+  , primCoerceDocsModule   , primOrderingDocsModule   , primRowDocsModule   , primRowListDocsModule@@ -35,7 +35,7 @@   , modComments = Just $ T.unlines       [ "The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import."       , ""-      , "`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler. For example, row kinds (e.g. `# Type`, which is the kind of types such as `(name :: String, age :: Int)`), Type wildcards (e.g. `f :: _ -> Int`), and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md)."+      , "`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md)."       ]   , modDeclarations =       [ function@@ -48,7 +48,9 @@       , boolean       , partial       , kindType+      , kindConstraint       , kindSymbol+      , kindRow       ]   , modReExports = []   }@@ -58,13 +60,22 @@   { modName = P.moduleNameFromString "Prim.Boolean"   , modComments = Just "The Prim.Boolean module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Boolean` data structure."   , modDeclarations =-      [ kindBoolean-      , booleanTrue+      [ booleanTrue       , booleanFalse       ]   , modReExports = []   } +primCoerceDocsModule :: Module+primCoerceDocsModule = Module+  { modName = P.moduleNameFromString "Prim.Coerce"+  , modComments = Just "The Prim.Coerce module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains an automatically solved type class for coercing types that have provably-identical runtime representations with [purescript-safe-coerce](https://pursuit.purescript.org/packages/purescript-safe-coerce)."+  , modDeclarations =+      [ coercible+      ]+  , modReExports = []+  }+ primOrderingDocsModule :: Module primOrderingDocsModule = Module   { modName = P.moduleNameFromString "Prim.Ordering"@@ -149,29 +160,10 @@   fromJust' (Just x) = x   fromJust' _ = P.internalError $ errorMsg ++ show name -primKindOf-  :: NameGen 'P.KindName-  -> Text-  -> Text-  -> Declaration-primKindOf g title comments =-  if Set.member (g title) P.allPrimKinds-     then Declaration-          { declTitle = title-          , declComments = Just comments-          , declSourceSpan = Nothing-          , declChildren = []-          , declInfo = ExternKindDeclaration-          }-    else P.internalError $ "Docs.Prim: No such Prim kind: " ++ T.unpack title--primKind :: Text -> Text -> Declaration-primKind = primKindOf P.primName- lookupPrimTypeKindOf   :: NameGen 'P.TypeName   -> Text-  -> Kind'+  -> Type' lookupPrimTypeKindOf k = ($> ()) . fst . unsafeLookupOf k   ( P.primTypes <>     P.primBooleanTypes <>@@ -198,6 +190,7 @@ lookupPrimClassOf :: NameGen 'P.ClassName -> Text -> P.TypeClassData lookupPrimClassOf g = unsafeLookupOf g   ( P.primClasses <>+    P.primCoerceClasses <>     P.primRowClasses <>     P.primRowListClasses <>     P.primSymbolClasses <>@@ -224,19 +217,38 @@   }  kindType :: Declaration-kindType = primKind "Type" $ T.unlines+kindType = primType "Type" $ T.unlines   [ "`Type` is the kind of all proper types: those that classify value-level terms."   , "For example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`."   ] +kindConstraint :: Declaration+kindConstraint = primType "Constraint" $ T.unlines+  [ "`Constraint` is the kind of type class constraints."+  , "For example, a type class declaration like this:"+  , ""+  , "    class Semigroup a where"+  , "      append :: a -> a -> a"+  , ""+  , "has the kind signature:"+  , ""+  , "    class Semigroup :: Type -> Constraint"+  ]+ kindSymbol :: Declaration-kindSymbol = primKind "Symbol" $ T.unlines+kindSymbol = primType "Symbol" $ T.unlines   [ "`Symbol` is the kind of type-level strings."   , ""   , "Construct types of this kind using the same literal syntax as documented"   , "for strings."   ] +kindRow :: Declaration+kindRow = primType "Row" $ T.unlines+  [ "`Row` is the kind constructor of label-indexed types which map type-level strings to other types."+  , "For example, the kind of `Record` is `Row Type -> Type`, mapping field names to values."+  ]+ function :: Declaration function = primType "Function" $ T.unlines   [ "A function, which takes values of the type specified by the first type"@@ -351,11 +363,6 @@   , "[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/)."   ] -kindBoolean :: Declaration-kindBoolean = primKindOf (P.primSubName "Boolean") "Boolean" $ T.unlines-  [ "The `Boolean` kind provides True/False types at the type level"-  ]- booleanTrue :: Declaration booleanTrue = primTypeOf (P.primSubName "Boolean") "True" $ T.unlines   [ "The 'True' boolean type."@@ -366,9 +373,65 @@   [ "The 'False' boolean type."   ] +coercible :: Declaration+coercible = primClassOf (P.primSubName "Coerce") "Coercible" $ T.unlines+  [ "Coercible is a two-parameter type class that has instances for types `a`"+  , "and `b` if the compiler can infer that they have the same representation."+  , "Coercible constraints are solved according to the following rules:"+  , ""+  , "* _reflexivity_, any type has the same representation as itself:"+  , "`Coercible a a` holds."+  , ""+  , "* _symmetry_, if a type `a` can be coerced to some other type `b`, then `b`"+  , "can also be coerced back to `a`: `Coercible a b` implies `Coercible b a`."+  , ""+  , "* _transitivity_, if a type `a` can be coerced to some other type `b` which"+  , "can be coerced to some other type `c`, then `a` can also be coerced to `c`:"+  , "`Coercible a b` and `Coercible b c` imply `Coercible a c`."+  , ""+  , "* Newtypes can be freely wrapped and unwrapped when their constructor is"+  , "in scope:"+  , ""+  , "      newtype Age = Age Int"+  , ""+  , "`Coercible Int Age` and `Coercible Age Int` hold since `Age` has the same"+  , "runtime representation than `Int`."+  , ""+  , "Newtype constructors have to be in scope to preserve abstraction. It's"+  , "common to declare a newtype to encode some invariants (non emptiness of"+  , "arrays with `Data.Array.NonEmpty.NonEmptyArray` for example), hide its"+  , "constructor and export smart constructors instead. Without this restriction,"+  , "the guarantees provided by such newtypes would be void."+  , ""+  , "* If none of the above are applicable, two types of kind `Type` may be"+  , "coercible, but only if their heads are the same. For example,"+  , "`Coercible (Maybe a) (Either a b)` does not hold because `Maybe` and"+  , "`Either` are different. Those types don't share a common runtime"+  , "representation so coercing between them would be unsafe. In addition their"+  , "arguments may need to be identical or coercible, depending on the _roles_"+  , "of the head's type parameters. Roles are documented in [the PureScript"+  , "language reference](https://github.com/purescript/documentation/blob/master/language/Roles.md)."+  , ""+  , "Coercible being polykinded, we can also coerce more than types of kind `Type`:"+  , ""+  , "* Rows are coercible when they have the same labels, when the corresponding"+  , "pairs of types are coercible and when their tails are coercible:"+  , "`Coercible ( label :: a | r ) ( label :: b | s )` holds when"+  , "`Coercible a b` and `Coercible r s` do. Closed rows cannot be coerced to"+  , "open rows."+  , ""+  , "* Higher kinded types are coercible if they are coercible when fully"+  , "saturated: `Coercible (f :: _ -> Type) (g :: _ -> Type)` holds when"+  , "`Coercible (f a) (g a)` does."+  , ""+  , "This rule may seem puzzling since there is no term of type `_ -> Type` to"+  , "apply `coerce` to, but it is necessary when coercing types with higher"+  , "kinded parameters."+  ]+ kindOrdering :: Declaration-kindOrdering = primKindOf (P.primSubName "Ordering") "Ordering" $ T.unlines-  [ "The `Ordering` kind represents the three possibilites of comparing two"+kindOrdering = primTypeOf (P.primSubName "Ordering") "Ordering" $ T.unlines+  [ "The `Ordering` kind represents the three possibilities of comparing two"   , "types of the same kind: `LT` (less than), `EQ` (equal to), and"   , "`GT` (greater than)."   ]@@ -414,7 +477,7 @@   ]  kindRowList :: Declaration-kindRowList = primKindOf (P.primSubName "RowList") "RowList" $ T.unlines+kindRowList = primTypeOf (P.primSubName "RowList") "RowList" $ T.unlines   [ "A type level list representation of a row of types."   ] @@ -474,10 +537,10 @@   ]  kindDoc :: Declaration-kindDoc = primKindOf (P.primSubName "TypeError") "Doc" $ T.unlines+kindDoc = primTypeOf (P.primSubName "TypeError") "Doc" $ T.unlines   [ "`Doc` is the kind of type-level documents."   , ""-  , "This kind is used with the `Fail` and `Warn` type clases."+  , "This kind is used with the `Fail` and `Warn` type classes."   , "Build up a `Doc` with `Text`, `Quote`, `QuoteLabel`, `Beside`, and `Above`."   ]
src/Language/PureScript/Docs/Render.hs view
@@ -40,7 +40,7 @@       [ keywordData       , renderType (P.TypeConstructor () (notQualified declTitle))       , syntax "::"-      , renderKind kind'+      , renderType kind'       ]     TypeSynonymDeclaration args ty ->       [ keywordType@@ -80,11 +80,6 @@       , aliasName for declTitle       ] -    ExternKindDeclaration ->-      [ keywordKind-      , kind (notQualified declTitle)-      ]- renderChildDeclaration :: ChildDeclaration -> RenderedCode renderChildDeclaration ChildDeclaration{..} =   mintersperse sp $ case cdeclInfo of@@ -101,8 +96,8 @@       ]  renderConstraint :: Constraint' -> RenderedCode-renderConstraint (P.Constraint ann pn tys _) =-  renderType $ foldl (P.TypeApp ann) (P.TypeConstructor ann (fmap P.coerceProperName pn)) tys+renderConstraint (P.Constraint ann pn kinds tys _) =+  renderType $ foldl (P.TypeApp ann) (foldl (P.KindApp ann) (P.TypeConstructor ann (fmap P.coerceProperName pn)) kinds) tys  renderConstraints :: [Constraint'] -> Maybe RenderedCode renderConstraints constraints@@ -125,12 +120,12 @@ dataCtor' :: Text -> RenderedCode dataCtor' = dataCtor . notQualified -typeApp :: Text -> [(Text, Maybe Kind')] -> Type'+typeApp :: Text -> [(Text, Maybe Type')] -> Type' typeApp title typeArgs =   foldl (P.TypeApp ())         (P.TypeConstructor () (notQualified title))         (map toTypeVar typeArgs) -toTypeVar :: (Text, Maybe Kind') -> Type'+toTypeVar :: (Text, Maybe Type') -> Type' toTypeVar (s, Nothing) = P.TypeVar () s toTypeVar (s, Just k) = P.KindedType () (P.TypeVar () s) k
src/Language/PureScript/Docs/RenderedCode.hs view
@@ -6,4 +6,3 @@  import Language.PureScript.Docs.RenderedCode.Types as RenderedCode import Language.PureScript.Docs.RenderedCode.RenderType as RenderedCode-import Language.PureScript.Docs.RenderedCode.RenderKind as RenderedCode
− src/Language/PureScript/Docs/RenderedCode/RenderKind.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | Functions for producing RenderedCode values from PureScript Kind values.----module Language.PureScript.Docs.RenderedCode.RenderKind-  ( renderKind-  ) where---- TODO: This is pretty much copied from Language.PureScript.Pretty.Kinds.--- Ideally we would unify the two.--import Prelude.Compat--import Control.Arrow (ArrowPlus(..))-import Control.PatternArrows as PA--import Data.Maybe (fromMaybe)-import qualified Data.Text as T--import Language.PureScript.Crash-import Language.PureScript.Kinds--import Language.PureScript.Docs.RenderedCode.Types--typeLiterals :: Pattern () (Kind a) RenderedCode-typeLiterals = mkPattern match-  where-  match (KUnknown _ u) =-    Just $ typeVar $ T.cons 'k' (T.pack (show u))-  match (NamedKind _ n) =-    Just $ kind n-  match _ = Nothing--matchRow :: Pattern () (Kind a) ((), Kind a)-matchRow = mkPattern match-  where-  match (Row _ k) = Just ((), k)-  match _ = Nothing--funKind :: Pattern () (Kind a) (Kind a, Kind a)-funKind = mkPattern match-  where-  match (FunKind _ arg ret) = Just (arg, ret)-  match _ = Nothing---- | Generate RenderedCode value representing a Kind-renderKind :: forall a. Kind a -> RenderedCode-renderKind-  = fromMaybe (internalError "Incomplete pattern")-  . PA.pattern matchKind ()-  where-  matchKind :: Pattern () (Kind a) RenderedCode-  matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchKind)--  operators :: OperatorTable () (Kind a) RenderedCode-  operators =-    OperatorTable [ [ Wrap matchRow $ \_ k -> syntax "#" <> sp <> k]-                  , [ AssocR funKind $ \arg ret -> arg <> sp <> syntax "->" <> sp <> ret ] ]
src/Language/PureScript/Docs/RenderedCode/RenderType.hs view
@@ -17,7 +17,6 @@ import Control.PatternArrows as PA  import Language.PureScript.Crash-import Language.PureScript.Kinds import Language.PureScript.Label import Language.PureScript.Names import Language.PureScript.Pretty.Types@@ -26,7 +25,6 @@  import Language.PureScript.Docs.RenderedCode.Types import Language.PureScript.Docs.Utils.MonoidExtras-import Language.PureScript.Docs.RenderedCode.RenderKind (renderKind)  typeLiterals :: Pattern () PrettyPrintType RenderedCode typeLiterals = mkPattern match@@ -55,8 +53,8 @@     Nothing  renderConstraint :: PrettyPrintConstraint -> RenderedCode-renderConstraint (pn, tys) =-  let instApp = foldl PPTypeApp (PPTypeConstructor (fmap coerceProperName pn)) tys+renderConstraint (pn, ks, tys) =+  let instApp = foldl PPTypeApp (foldl (\a b -> PPTypeApp a (PPKindArg b)) (PPTypeConstructor (fmap coerceProperName pn)) ks) tys   in  renderType' instApp  renderConstraints :: PrettyPrintConstraint -> RenderedCode -> RenderedCode@@ -94,16 +92,22 @@   match (PPTypeApp f x) = Just (f, x)   match _ = Nothing +kindArg :: Pattern () PrettyPrintType ((), PrettyPrintType)+kindArg = mkPattern match+  where+  match (PPKindArg ty) = Just ((), ty)+  match _ = Nothing+ appliedFunction :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType) appliedFunction = mkPattern match   where   match (PPFunction arg ret) = Just (arg, ret)   match _ = Nothing -kinded :: Pattern () PrettyPrintType (Kind (), PrettyPrintType)+kinded :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType) kinded = mkPattern match   where-  match (PPKindedType t k) = Just (k, t)+  match (PPKindedType t k) = Just (t, k)   match _ = Nothing  constrained :: Pattern () PrettyPrintType (PrettyPrintConstraint, PrettyPrintType)@@ -128,15 +132,16 @@   where   operators :: OperatorTable () PrettyPrintType RenderedCode   operators =-    OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]+    OperatorTable [ [ Wrap kindArg $ \_ ty -> syntax "@" <> ty ]+                  , [ AssocL typeApp $ \f x -> f <> sp <> x ]                   , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]                   , [ Wrap constrained $ \deps ty -> renderConstraints deps ty ]                   , [ Wrap forall_ $ \tyVars ty -> mconcat [ keywordForall, sp, renderTypeVars tyVars, syntax ".", sp, ty ] ]-                  , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]+                  , [ Wrap kinded $ \ty k -> mintersperse sp [renderType' ty, syntax "::", k] ]                   , [ Wrap explicitParens $ \_ ty -> ty ]                   ] -forall_ :: Pattern () PrettyPrintType ([(Text, Maybe (Kind ()))], PrettyPrintType)+forall_ :: Pattern () PrettyPrintType ([(Text, Maybe PrettyPrintType)], PrettyPrintType) forall_ = mkPattern match   where   match (PPForAll mbKindedIdents ty) = Just (mbKindedIdents, ty)@@ -153,13 +158,13 @@   = fromMaybe (internalError "Incomplete pattern")   . PA.pattern matchType () -renderTypeVars :: [(Text, Maybe (Kind a))] -> RenderedCode+renderTypeVars :: [(Text, Maybe PrettyPrintType)] -> RenderedCode renderTypeVars tyVars = mintersperse sp (map renderTypeVar tyVars) -renderTypeVar :: (Text, Maybe (Kind a)) -> RenderedCode+renderTypeVar :: (Text, Maybe PrettyPrintType) -> RenderedCode renderTypeVar (v, mbK) = case mbK of   Nothing -> typeVar v-  Just k -> mintersperse sp [ mconcat [syntax "(", typeVar v], syntax "::", mconcat [renderKind k, syntax ")"] ]+  Just k -> mintersperse sp [ mconcat [syntax "(", typeVar v], syntax "::", mconcat [renderType' k, syntax ")"] ]  -- | -- Render code representing a Type, as it should appear inside parentheses
src/Language/PureScript/Docs/RenderedCode/Types.hs view
@@ -38,7 +38,6 @@  , typeCtor  , typeOp  , typeVar- , kind  , alias  , aliasName  ) where@@ -58,7 +57,6 @@  import Language.PureScript.Names import Language.PureScript.AST (Associativity(..))-import Language.PureScript.Crash (internalError)  -- | Given a list of actions, attempt them all, returning the first success. -- If all the actions fail, 'tryAll' returns the first argument.@@ -170,7 +168,6 @@ data Namespace   = ValueLevel   | TypeLevel-  | KindLevel   deriving (Show, Eq, Ord, Generic)  instance NFData Namespace@@ -184,7 +181,6 @@     [ withText $ \case         "ValueLevel" -> Right ValueLevel         "TypeLevel" -> Right TypeLevel-        "KindLevel" -> Right KindLevel         _ -> Left ""     ] @@ -234,12 +230,10 @@   backwardsCompat =     [ oldAsIdent     , oldAsCtor-    , oldAsKind     ]    oldAsIdent = firstEq "ident" (Symbol ValueLevel <$> nth 1 asText <*> nth 2 (Link <$> asContainingModule))   oldAsCtor = firstEq "ctor" (Symbol TypeLevel <$> nth 1 asText <*> nth 2 (Link <$> asContainingModule))-  oldAsKind = firstEq "kind" (Symbol KindLevel <$> nth 1 asText <*> pure (Link ThisModule))  -- | -- A type representing a highly simplified version of PureScript code, intended@@ -335,10 +329,6 @@ typeVar :: Text -> RenderedCode typeVar x = RC [Symbol TypeLevel x NoLink] -kind :: Qualified (ProperName 'KindName) -> RenderedCode-kind (fromQualified -> (mn, name)) =-  RC [Symbol KindLevel (runProperName name) (Link mn)]- type FixityAlias = Qualified (Either (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName)))  alias :: FixityAlias -> RenderedCode@@ -364,8 +354,6 @@         ident (Qualified Nothing (Ident name))       TypeLevel ->         typeCtor (Qualified Nothing (ProperName name))-      KindLevel ->-        internalError "Kind aliases are not supported"  -- | Converts a FixityAlias into a different representation which is more -- useful to other functions in this module.
src/Language/PureScript/Docs/Types.hs view
@@ -31,7 +31,6 @@ import qualified Language.PureScript.CoreFn.FromJSON as P import qualified Language.PureScript.Crash as P import qualified Language.PureScript.Environment as P-import qualified Language.PureScript.Kinds as P import qualified Language.PureScript.Names as P import qualified Language.PureScript.Types as P import qualified Paths_purescript as Paths@@ -45,7 +44,6 @@    Namespace(..), FixityAlias)  type Type' = P.Type ()-type Kind' = P.Kind () type Constraint' = P.Constraint ()  --------------------@@ -163,39 +161,34 @@   -- newtype) and its type arguments. Constructors are represented as child   -- declarations.   ---  | DataDeclaration P.DataDeclType [(Text, Maybe Kind')]+  | DataDeclaration P.DataDeclType [(Text, Maybe Type')]    -- |   -- A data type foreign import, with its kind.   ---  | ExternDataDeclaration Kind'+  | ExternDataDeclaration Type'    -- |   -- A type synonym, with its type arguments and its type.   ---  | TypeSynonymDeclaration [(Text, Maybe Kind')] Type'+  | TypeSynonymDeclaration [(Text, Maybe Type')] Type'    -- |   -- A type class, with its type arguments, its superclasses and functional   -- dependencies. Instances and members are represented as child declarations.   ---  | TypeClassDeclaration [(Text, Maybe Kind')] [Constraint'] [([Text], [Text])]+  | TypeClassDeclaration [(Text, Maybe Type')] [Constraint'] [([Text], [Text])]    -- |   -- An operator alias declaration, with the member the alias is for and the   -- operator's fixity.   --   | AliasDeclaration P.Fixity FixityAlias--  -- |-  -- A kind declaration-  ---  | ExternKindDeclaration   deriving (Show, Eq, Ord, Generic)  instance NFData DeclarationInfo -convertFundepsToStrings :: [(Text, Maybe Kind')] -> [P.FunctionalDependency] -> [([Text], [Text])]+convertFundepsToStrings :: [(Text, Maybe Type')] -> [P.FunctionalDependency] -> [([Text], [Text])] convertFundepsToStrings args fundeps =   map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps   where@@ -220,7 +213,6 @@ declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym" declInfoToString (TypeClassDeclaration _ _ _) = "typeClass" declInfoToString (AliasDeclaration _ _) = "alias"-declInfoToString ExternKindDeclaration = "kind"  declInfoNamespace :: DeclarationInfo -> Namespace declInfoNamespace = \case@@ -236,8 +228,6 @@     TypeLevel   AliasDeclaration _ alias ->     either (const TypeLevel) (const ValueLevel) (P.disqualify alias)-  ExternKindDeclaration{} ->-    KindLevel  isTypeClass :: Declaration -> Bool isTypeClass Declaration{..} =@@ -271,12 +261,6 @@     AliasDeclaration _ (P.Qualified _ d) -> isLeft d     _ -> False -isKind :: Declaration -> Bool-isKind Declaration{..} =-  case declInfo of-    ExternKindDeclaration{} -> True-    _ -> False- -- | Discard any children which do not satisfy the given predicate. filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration filterChildren p decl =@@ -634,7 +618,7 @@       DataDeclaration <$> key "dataDeclType" asDataDeclType                       <*> key "typeArguments" asTypeArguments     "externData" ->-      ExternDataDeclaration <$> key "kind" asKind+      ExternDataDeclaration <$> key "kind" asType     "typeSynonym" ->       TypeSynonymDeclaration <$> key "arguments" asTypeArguments                              <*> key "type" asType@@ -645,18 +629,16 @@     "alias" ->       AliasDeclaration <$> key "fixity" asFixity                        <*> key "alias" asFixityAlias+    -- Backwards compat: kinds are extern data     "kind" ->-      pure ExternKindDeclaration+      pure $ ExternDataDeclaration (P.kindType $> ())     other ->       throwCustomError (InvalidDeclarationType other) -asTypeArguments :: Parse PackageError [(Text, Maybe Kind')]+asTypeArguments :: Parse PackageError [(Text, Maybe Type')] asTypeArguments = eachInArray asTypeArgument   where-  asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asKind)--asKind :: Parse PackageError Kind'-asKind = fromAesonParser .! InvalidKind+  asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asType)  asType :: Parse e Type' asType = fromAesonParser@@ -700,6 +682,7 @@  asConstraint :: Parse PackageError Constraint' asConstraint = P.Constraint () <$> key "constraintClass" asQualifiedProperName+                               <*> keyOrDefault "constraintKindArgs" [] (eachInArray asType)                                <*> key "constraintArgs" (eachInArray asType)                                <*> pure Nothing @@ -818,7 +801,6 @@       TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]       TypeClassDeclaration args super fundeps -> ["arguments" .= args, "superclasses" .= super, "fundeps" .= fundeps]       AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]-      ExternKindDeclaration -> []  instance A.ToJSON ChildDeclarationInfo where   toJSON info = A.object $ "declType" .= childDeclInfoToString info : props
− src/Language/PureScript/Environment.hs 
@@ -1,622 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Language.PureScript.Environment where--import           Prelude.Compat-import           Protolude (ordNub)--import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import Codec.Serialise (Serialise)-import Data.Aeson ((.=), (.:))-import qualified Data.Aeson as A-import qualified Data.Map as M-import qualified Data.Set as S-import           Data.Maybe (fromMaybe, mapMaybe)-import           Data.Text (Text)-import qualified Data.Text as T-import           Data.Tree (Tree, rootLabel)-import qualified Data.Graph as G-import           Data.Foldable (toList, fold)-import qualified Data.List.NonEmpty as NEL--import           Language.PureScript.AST.SourcePos-import           Language.PureScript.Crash-import           Language.PureScript.Kinds-import           Language.PureScript.Names-import           Language.PureScript.TypeClassDictionaries-import           Language.PureScript.Types-import qualified Language.PureScript.Constants as C---- | The @Environment@ defines all values and types which are currently in scope:-data Environment = Environment-  { names :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)-  -- ^ Values currently in scope-  , types :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-  -- ^ Type names currently in scope-  , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, SourceType, [Ident])-  -- ^ Data constructors currently in scope, along with their associated type-  -- constructor name, argument types and return type.-  , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceKind)], SourceType)-  -- ^ Type synonyms currently in scope-  , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict)))-  -- ^ Available type class dictionaries. When looking up 'Nothing' in the-  -- outer map, this returns the map of type class dictionaries in local-  -- scope (ie dictionaries brought in by a constrained type).-  , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-  -- ^ Type classes-  , kinds :: S.Set (Qualified (ProperName 'KindName))-  -- ^ Kinds in scope-  } deriving (Show, Generic)--instance NFData Environment---- | Information about a type class-data TypeClassData = TypeClassData-  { typeClassArguments :: [(Text, Maybe SourceKind)]-  -- ^ A list of type argument names, and their kinds, where kind annotations-  -- were provided.-  , typeClassMembers :: [(Ident, SourceType)]-  -- ^ A list of type class members and their types. Type arguments listed above-  -- are considered bound in these types.-  , typeClassSuperclasses :: [SourceConstraint]-  -- ^ A list of superclasses of this type class. Type arguments listed above-  -- are considered bound in the types appearing in these constraints.-  , typeClassDependencies :: [FunctionalDependency]-  -- ^ A list of functional dependencies for the type arguments of this class.-  , typeClassDeterminedArguments :: S.Set Int-  -- ^ A set of indexes of type argument that are fully determined by other-  -- arguments via functional dependencies. This can be computed from both-  -- typeClassArguments and typeClassDependencies.-  , typeClassCoveringSets :: S.Set (S.Set Int)-  -- ^ A sets of arguments that can be used to infer all other arguments.-  , typeClassIsEmpty :: Bool-  -- ^ Whether or not dictionaries for this type class are necessarily empty.-  } deriving (Show, Generic)--instance NFData TypeClassData---- | A functional dependency indicates a relationship between two sets of--- type arguments in a class declaration.-data FunctionalDependency = FunctionalDependency-  { fdDeterminers :: [Int]-  -- ^ the type arguments which determine the determined type arguments-  , fdDetermined  :: [Int]-  -- ^ the determined type arguments-  } deriving (Show, Generic)--instance NFData FunctionalDependency-instance Serialise FunctionalDependency--instance A.FromJSON FunctionalDependency where-  parseJSON = A.withObject "FunctionalDependency" $ \o ->-    FunctionalDependency-      <$> o .: "determiners"-      <*> o .: "determined"--instance A.ToJSON FunctionalDependency where-  toJSON FunctionalDependency{..} =-    A.object [ "determiners" .= fdDeterminers-             , "determined" .= fdDetermined-             ]---- | The initial environment with no values and only the default javascript types defined-initEnvironment :: Environment-initEnvironment = Environment M.empty allPrimTypes M.empty M.empty M.empty allPrimClasses allPrimKinds---- | A constructor for TypeClassData that computes which type class arguments are fully determined--- and argument covering sets.--- Fully determined means that this argument cannot be used when selecting a type class instance.--- A covering set is a minimal collection of arguments that can be used to find an instance and--- therefore determine all other type arguments.------ An example of the difference between determined and fully determined would be with the class:--- ```class C a b c | a -> b, b -> a, b -> c```--- In this case, `a` must differ when `b` differs, and vice versa - each is determined by the other.--- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is--- fully determined by `a` and `b`.------ Define a graph of type class arguments with edges being fundep determiners to determined. Each--- argument also has a self looping edge.--- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.--- An argument is not fully determined otherwise.------ The way we compute this is by saying: an argument X is fully determined if there are arguments that--- determine X that X does not determine. This is the same thing: everything X determines includes everything--- in its SCC, and everything determining X is either before it in an SCC path, or in the same SCC.-makeTypeClassData-  :: [(Text, Maybe SourceKind)]-  -> [(Ident, SourceType)]-  -> [SourceConstraint]-  -> [FunctionalDependency]-  -> Bool-  -> TypeClassData-makeTypeClassData args m s deps tcIsEmpty = TypeClassData args m s deps determinedArgs coveringSets tcIsEmpty-  where-    argumentIndicies = [0 .. length args - 1]--    -- each argument determines themselves-    identities = (\i -> (i, [i])) <$> argumentIndicies--    -- list all the edges in the graph: for each fundep an edge exists for each determiner to each determined-    contributingDeps = M.fromListWith (++) $ identities ++ do-      fd <- deps-      src <- fdDeterminers fd-      (src, fdDetermined fd) : map (, []) (fdDetermined fd)--    -- build a graph of which arguments determine other arguments-    (depGraph, fromVertex, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, ordNub v)) <$> M.toList contributingDeps)--    -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to-    isFunDepDetermined :: Int -> Bool-    isFunDepDetermined arg = case fromKey arg of-      Nothing -> internalError "Unknown argument index in makeTypeClassData"-      Just v -> let contributesToVar = G.reachable (G.transposeG depGraph) v-                    varContributesTo = G.reachable depGraph v-                in any (\r -> not (r `elem` varContributesTo)) contributesToVar--    -- find all the arguments that are determined-    determinedArgs :: S.Set Int-    determinedArgs = S.fromList $ filter isFunDepDetermined argumentIndicies--    argFromVertex :: G.Vertex -> Int-    argFromVertex index = let (_, arg, _) = fromVertex index in arg--    isVertexDetermined :: G.Vertex -> Bool-    isVertexDetermined = isFunDepDetermined . argFromVertex--    -- from an scc find the non-determined args-    sccNonDetermined :: Tree G.Vertex -> Maybe [Int]-    sccNonDetermined tree-      -- if any arg in an scc is determined then all of them are-      | isVertexDetermined (rootLabel tree) = Nothing-      | otherwise = Just (argFromVertex <$> toList tree)--    -- find the covering sets-    coveringSets :: S.Set (S.Set Int)-    coveringSets = let funDepSets = sequence (mapMaybe sccNonDetermined (G.scc depGraph))-                   in S.fromList (S.fromList <$> funDepSets)---- | The visibility of a name in scope-data NameVisibility-  = Undefined-  -- ^ The name is defined in the current binding group, but is not visible-  | Defined-  -- ^ The name is defined in the another binding group, or has been made visible by a function binder-  deriving (Show, Eq, Generic)--instance NFData NameVisibility-instance Serialise NameVisibility---- | A flag for whether a name is for an private or public value - only public values will be--- included in a generated externs file.-data NameKind-  = Private-  -- ^ A private value introduced as an artifact of code generation (class instances, class member-  -- accessors, etc.)-  | Public-  -- ^ A public value for a module member or foreing import declaration-  | External-  -- ^ A name for member introduced by foreign import-  deriving (Show, Eq, Generic)--instance NFData NameKind-instance Serialise NameKind---- | The kinds of a type-data TypeKind-  = DataType [(Text, Maybe SourceKind)] [(ProperName 'ConstructorName, [SourceType])]-  -- ^ Data type-  | TypeSynonym-  -- ^ Type synonym-  | ExternData-  -- ^ Foreign data-  | LocalTypeVariable-  -- ^ A local type variable-  | ScopedTypeVar-  -- ^ A scoped type variable-  deriving (Show, Eq, Generic)--instance NFData TypeKind-instance Serialise TypeKind--instance A.ToJSON TypeKind where-  toJSON (DataType args ctors) =-    A.object [ T.pack "DataType" .= A.object ["args" .= args, "ctors" .= ctors] ]-  toJSON TypeSynonym       = A.toJSON (T.pack "TypeSynonym")-  toJSON ExternData        = A.toJSON (T.pack "ExternData")-  toJSON LocalTypeVariable = A.toJSON (T.pack "LocalTypeVariable")-  toJSON ScopedTypeVar     = A.toJSON (T.pack "ScopedTypeVar")--instance A.FromJSON TypeKind where-  parseJSON (A.Object o) = do-    args <- o .: "DataType"-    A.withObject "args" (\o1 ->-      DataType <$> o1 .: "args"-               <*> o1 .: "ctors") args-  parseJSON (A.String s) =-    case s of-      "TypeSynonym"       -> pure TypeSynonym-      "ExternData"        -> pure ExternData-      "LocalTypeVariable" -> pure LocalTypeVariable-      "ScopedTypeVar"     -> pure ScopedTypeVar-      _ -> fail "Unknown TypeKind"-  parseJSON _ = fail "Invalid TypeKind"---- | The type ('data' or 'newtype') of a data type declaration-data DataDeclType-  = Data-  -- ^ A standard data constructor-  | Newtype-  -- ^ A newtype constructor-  deriving (Show, Eq, Ord, Generic)--instance NFData DataDeclType-instance Serialise DataDeclType--showDataDeclType :: DataDeclType -> Text-showDataDeclType Data = "data"-showDataDeclType Newtype = "newtype"--instance A.ToJSON DataDeclType where-  toJSON = A.toJSON . showDataDeclType--instance A.FromJSON DataDeclType where-  parseJSON = A.withText "DataDeclType" $ \str ->-    case str of-      "data" -> return Data-      "newtype" -> return Newtype-      other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"---- | Construct a ProperName in the Prim module-primName :: Text -> Qualified (ProperName a)-primName = Qualified (Just C.Prim) . ProperName---- | Construct a 'ProperName' in the @Prim.NAME@ module.-primSubName :: Text -> Text -> Qualified (ProperName a)-primSubName sub =-  Qualified (Just $ ModuleName $ C.prim <> "." <> sub) . ProperName--primKind :: Text -> SourceKind-primKind = NamedKind nullSourceAnn . primName--primSubKind :: Text -> Text -> SourceKind-primSubKind sub = NamedKind nullSourceAnn . primSubName sub---- | Kind of ground types-kindType :: SourceKind-kindType = primKind C.typ--kindConstraint :: SourceKind-kindConstraint = kindType--isKindType :: Kind a -> Bool-isKindType (NamedKind _ n) = n == primName C.typ-isKindType _ = False---- To make reading the kind signatures below easier-(-:>) :: SourceKind -> SourceKind -> SourceKind-(-:>) = FunKind nullSourceAnn-infixr 4 -:>--kindSymbol :: SourceKind-kindSymbol = primKind C.symbol--kindDoc :: SourceKind-kindDoc = primSubKind C.typeError C.doc--kindBoolean :: SourceKind-kindBoolean = primSubKind C.moduleBoolean C.kindBoolean--kindOrdering :: SourceKind-kindOrdering = primSubKind C.moduleOrdering C.kindOrdering--kindRowList :: SourceKind-kindRowList = primSubKind C.moduleRowList C.kindRowList--kindRow :: SourceKind -> SourceKind-kindRow = Row nullSourceAnn---- | Construct a type in the Prim module-primTy :: Text -> SourceType-primTy = TypeConstructor nullSourceAnn . primName---- | Type constructor for functions-tyFunction :: SourceType-tyFunction = primTy "Function"---- | Type constructor for strings-tyString :: SourceType-tyString = primTy "String"---- | Type constructor for strings-tyChar :: SourceType-tyChar = primTy "Char"---- | Type constructor for numbers-tyNumber :: SourceType-tyNumber = primTy "Number"---- | Type constructor for integers-tyInt :: SourceType-tyInt = primTy "Int"---- | Type constructor for booleans-tyBoolean :: SourceType-tyBoolean = primTy "Boolean"---- | Type constructor for arrays-tyArray :: SourceType-tyArray = primTy "Array"---- | Type constructor for records-tyRecord :: SourceType-tyRecord = primTy "Record"---- | Check whether a type is a record-isObject :: Type a -> Bool-isObject = isTypeOrApplied tyRecord---- | Check whether a type is a function-isFunction :: Type a -> Bool-isFunction = isTypeOrApplied tyFunction--isTypeOrApplied :: Type a -> Type b -> Bool-isTypeOrApplied t1 (TypeApp _ t2 _) = eqType t1 t2-isTypeOrApplied t1 t2 = eqType t1 t2---- | Smart constructor for function types-function :: SourceType -> SourceType -> SourceType-function t1 t2 = TypeApp nullSourceAnn (TypeApp nullSourceAnn tyFunction t1) t2---- | Kinds in @Prim@-primKinds :: S.Set (Qualified (ProperName 'KindName))-primKinds = S.fromList-  [ primName C.typ-  , primName C.symbol-  ]---- | Kinds in @Prim.Boolean@-primBooleanKinds :: S.Set (Qualified (ProperName 'KindName))-primBooleanKinds = S.fromList-  [ primSubName C.moduleBoolean C.kindBoolean-  ]---- | Kinds in @Prim.Ordering@-primOrderingKinds :: S.Set (Qualified (ProperName 'KindName))-primOrderingKinds = S.fromList-  [ primSubName C.moduleOrdering C.kindOrdering-  ]---- | Kinds in @Prim.RowList@-primRowListKinds :: S.Set (Qualified (ProperName 'KindName))-primRowListKinds = S.fromList-  [ primSubName C.moduleRowList C.kindRowList-  ]---- | Kinds in @Prim.TypeError@-primTypeErrorKinds :: S.Set (Qualified (ProperName 'KindName))-primTypeErrorKinds = S.fromList-  [ primSubName C.typeError C.doc-  ]---- | All primitive kinds-allPrimKinds :: S.Set (Qualified (ProperName 'KindName))-allPrimKinds = fold-  [ primKinds-  , primBooleanKinds-  , primOrderingKinds-  , primRowListKinds-  , primTypeErrorKinds-  ]---- | The primitive types in the external javascript environment with their--- associated kinds. There are also pseudo `Fail`, `Warn`, and `Partial` types--- that correspond to the classes with the same names.-primTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primTypes = M.fromList-  [ (primName "Function", (kindType -:> kindType -:> kindType, ExternData))-  , (primName "Array",    (kindType -:> kindType, ExternData))-  , (primName "Record",   (kindRow kindType -:> kindType, ExternData))-  , (primName "String",   (kindType, ExternData))-  , (primName "Char",     (kindType, ExternData))-  , (primName "Number",   (kindType, ExternData))-  , (primName "Int",      (kindType, ExternData))-  , (primName "Boolean",  (kindType, ExternData))-  , (primName "Partial",  (kindConstraint, ExternData))-  ]---- | This 'Map' contains all of the prim types from all Prim modules.-allPrimTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-allPrimTypes = M.unions-  [ primTypes-  , primBooleanTypes-  , primOrderingTypes-  , primRowTypes-  , primRowListTypes-  , primSymbolTypes-  , primTypeErrorTypes-  ]--primBooleanTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primBooleanTypes =-  M.fromList-    [ (primSubName C.moduleBoolean "True", (kindBoolean, ExternData))-    , (primSubName C.moduleBoolean "False", (kindBoolean, ExternData))-    ]--primOrderingTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primOrderingTypes =-  M.fromList-    [ (primSubName C.moduleOrdering "LT", (kindOrdering, ExternData))-    , (primSubName C.moduleOrdering "EQ", (kindOrdering, ExternData))-    , (primSubName C.moduleOrdering "GT", (kindOrdering, ExternData))-    ]--primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primRowTypes =-  M.fromList-    [ (primSubName C.moduleRow "Union", (kindRow kindType -:> kindRow kindType -:> kindRow kindType -:> kindConstraint, ExternData))-    , (primSubName C.moduleRow "Nub", (kindRow kindType -:> kindRow kindType -:> kindConstraint, ExternData))-    , (primSubName C.moduleRow "Lacks", (kindSymbol -:> kindRow kindType -:> kindConstraint, ExternData))-    , (primSubName C.moduleRow "Cons",  (kindSymbol -:> kindType -:> kindRow kindType -:> kindRow kindType -:> kindConstraint, ExternData))-    ]--primRowListTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primRowListTypes =-  M.fromList-    [ (primSubName C.moduleRowList "Cons", (kindSymbol -:> kindType -:> kindRowList -:> kindRowList, ExternData))-    , (primSubName C.moduleRowList "Nil", (kindRowList, ExternData))-    , (primSubName C.moduleRowList "RowToList",  (kindRow kindType -:> kindRowList -:> kindConstraint, ExternData))-    ]--primSymbolTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primSymbolTypes =-  M.fromList-    [ (primSubName C.moduleSymbol "Append",  (kindSymbol -:> kindSymbol -:> kindSymbol -:> kindConstraint, ExternData))-    , (primSubName C.moduleSymbol "Compare", (kindSymbol -:> kindSymbol -:> kindOrdering -:> kindConstraint, ExternData))-    , (primSubName C.moduleSymbol "Cons",  (kindSymbol -:> kindSymbol -:> kindSymbol -:> kindConstraint, ExternData))-    ]--primTypeErrorTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)-primTypeErrorTypes =-  M.fromList-    [ (primSubName C.typeError "Fail", (kindDoc -:> kindConstraint, ExternData))-    , (primSubName C.typeError "Warn", (kindDoc -:> kindConstraint, ExternData))-    , (primSubName C.typeError "Text", (kindSymbol -:> kindDoc, ExternData))-    , (primSubName C.typeError "Quote", (kindType -:> kindDoc, ExternData))-    , (primSubName C.typeError "QuoteLabel", (kindSymbol -:> kindDoc, ExternData))-    , (primSubName C.typeError "Beside", (kindDoc -:> kindDoc -:> kindDoc, ExternData))-    , (primSubName C.typeError "Above", (kindDoc -:> kindDoc -:> kindDoc, ExternData))-    ]---- | The primitive class map. This just contains the `Partial` class.--- `Partial` is used as a kind of magic constraint for partial functions.-primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-primClasses =-  M.fromList-    [ (primName "Partial", (makeTypeClassData [] [] [] [] True))-    ]---- | This contains all of the type classes from all Prim modules.-allPrimClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-allPrimClasses = M.unions-  [ primClasses-  , primRowClasses-  , primRowListClasses-  , primSymbolClasses-  , primTypeErrorClasses-  ]--primRowClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-primRowClasses =-  M.fromList-    -- class Union (left :: # Type) (right :: # Type) (union :: # Type) | left right -> union, right union -> left, union left -> right-    [ (primSubName C.moduleRow "Union", makeTypeClassData-        [ ("left", Just (kindRow kindType))-        , ("right", Just (kindRow kindType))-        , ("union", Just (kindRow kindType))-        ] [] []-        [ FunctionalDependency [0, 1] [2]-        , FunctionalDependency [1, 2] [0]-        , FunctionalDependency [2, 0] [1]-        ] True)--    -- class Nub (original :: # Type) (nubbed :: # Type) | i -> o-    , (primSubName C.moduleRow "Nub", makeTypeClassData-        [ ("original", Just (kindRow kindType))-        , ("nubbed", Just (kindRow kindType))-        ] [] []-        [ FunctionalDependency [0] [1]-        ] True)--    -- class Lacks (label :: Symbol) (row :: # Type)-    , (primSubName C.moduleRow "Lacks", makeTypeClassData-        [ ("label", Just kindSymbol)-        , ("row", Just (kindRow kindType))-        ] [] [] [] True)--    -- class RowCons (label :: Symbol) (a :: Type) (tail :: # Type) (row :: # Type) | label tail a -> row, label row -> tail a-    , (primSubName C.moduleRow "Cons", makeTypeClassData-        [ ("label", Just kindSymbol)-        , ("a", Just kindType)-        , ("tail", Just (kindRow kindType))-        , ("row", Just (kindRow kindType))-        ] [] []-        [ FunctionalDependency [0, 1, 2] [3]-        , FunctionalDependency [0, 3] [1, 2]-        ] True)-    ]--primRowListClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-primRowListClasses =-  M.fromList-    -- class RowToList (row :: # Type) (list :: RowList) | row -> list-    [ (primSubName C.moduleRowList "RowToList", makeTypeClassData-        [ ("row", Just (kindRow kindType))-        , ("list", Just kindRowList)-        ] [] []-        [ FunctionalDependency [0] [1]-        ] True)-    ]--primSymbolClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-primSymbolClasses =-  M.fromList-    -- class Append (left :: Symbol) (right :: Symbol) (appended :: Symbol) | left right -> appended, right appended -> left, appended left -> right-    [ (primSubName C.moduleSymbol "Append", makeTypeClassData-        [ ("left", Just kindSymbol)-        , ("right", Just kindSymbol)-        , ("appended", Just kindSymbol)-        ] [] []-        [ FunctionalDependency [0, 1] [2]-        , FunctionalDependency [1, 2] [0]-        , FunctionalDependency [2, 0] [1]-        ] True)--    -- class Compare (left :: Symbol) (right :: Symbol) (ordering :: Ordering) | left right -> ordering-    , (primSubName C.moduleSymbol "Compare", makeTypeClassData-        [ ("left", Just kindSymbol)-        , ("right", Just kindSymbol)-        , ("ordering", Just kindOrdering)-        ] [] []-        [ FunctionalDependency [0, 1] [2]-        ] True)--    -- class Cons (head :: Symbol) (tail :: Symbol) (symbol :: Symbol) | head tail -> symbol, symbol -> head tail-    , (primSubName C.moduleSymbol "Cons", makeTypeClassData-        [ ("head", Just kindSymbol)-        , ("tail", Just kindSymbol)-        , ("symbol", Just kindSymbol)-        ] [] []-        [ FunctionalDependency [0, 1] [2]-        , FunctionalDependency [2] [0, 1]-        ] True)-    ]--primTypeErrorClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData-primTypeErrorClasses =-  M.fromList-    -- class Fail (message :: Symbol)-    [ (primSubName C.typeError "Fail", makeTypeClassData-        [("message", Just kindDoc)] [] [] [] True)--    -- class Warn (message :: Symbol)-    , (primSubName C.typeError "Warn", makeTypeClassData-        [("message", Just kindDoc)] [] [] [] True)-    ]---- | Finds information about data constructors from the current environment.-lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])-lookupConstructor env ctor =-  fromMaybe (internalError "Data constructor not found") $ ctor `M.lookup` dataConstructors env---- | Checks whether a data constructor is for a newtype.-isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool-isNewtypeConstructor e ctor = case lookupConstructor e ctor of-  (Newtype, _, _, _) -> True-  (Data, _, _, _) -> False---- | Finds information about values from the current environment.-lookupValue :: Environment -> Qualified Ident -> Maybe (SourceType, NameKind, NameVisibility)-lookupValue env ident = ident `M.lookup` names env
src/Language/PureScript/Errors.hs view
@@ -27,17 +27,21 @@ import qualified Data.Set as S import qualified Data.Text as T import           Data.Text (Text)+import qualified GHC.Stack import           Language.PureScript.AST import qualified Language.PureScript.Bundle as Bundle-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Prim as C import           Language.PureScript.Crash import qualified Language.PureScript.CST.Errors as CST+import qualified Language.PureScript.CST.Print as CST import           Language.PureScript.Environment import           Language.PureScript.Label (Label(..)) import           Language.PureScript.Names import           Language.PureScript.Pretty import           Language.PureScript.Pretty.Common (endWith) import           Language.PureScript.PSString (decodeStringWithReplacement)+import           Language.PureScript.Roles import           Language.PureScript.Traversals import           Language.PureScript.Types import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers@@ -47,6 +51,148 @@ import           Text.Parsec.Error (Message(..)) import qualified Text.PrettyPrint.Boxes as Box +-- | A type of error messages+data SimpleErrorMessage+  = InternalCompilerError Text Text+  | ModuleNotFound ModuleName+  | ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)+  | ErrorParsingModule P.ParseError+  | ErrorParsingCSTModule CST.ParserError+  | WarningParsingCSTModule CST.ParserWarning+  | MissingFFIModule ModuleName+  | UnnecessaryFFIModule ModuleName FilePath+  | MissingFFIImplementations ModuleName [Ident]+  | UnusedFFIImplementations ModuleName [Ident]+  | InvalidFFIIdentifier ModuleName Text+  | DeprecatedFFIPrime ModuleName Text+  | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred+  | InfiniteType SourceType+  | InfiniteKind SourceType+  | MultipleValueOpFixities (OpName 'ValueOpName)+  | MultipleTypeOpFixities (OpName 'TypeOpName)+  | OrphanTypeDeclaration Ident+  | OrphanKindDeclaration (ProperName 'TypeName)+  | OrphanRoleDeclaration (ProperName 'TypeName)+  | RedefinedIdent Ident+  | OverlappingNamesInLet+  | UnknownName (Qualified Name)+  | UnknownImport ModuleName Name+  | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)+  | UnknownExport Name+  | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)+  | ScopeConflict Name [ModuleName]+  | ScopeShadowing Name (Maybe ModuleName) [ModuleName]+  | DeclConflict Name Name+  | ExportConflict (Qualified Name) (Qualified Name)+  | DuplicateModule ModuleName+  | DuplicateTypeClass (ProperName 'ClassName) SourceSpan+  | DuplicateInstance Ident SourceSpan+  | DuplicateTypeArgument Text+  | InvalidDoBind+  | InvalidDoLet+  | CycleInDeclaration Ident+  | CycleInTypeSynonym [ProperName 'TypeName]+  | CycleInTypeClassDeclaration [Qualified (ProperName 'ClassName)]+  | CycleInKindDeclaration [Qualified (ProperName 'TypeName)]+  | CycleInModules [ModuleName]+  | NameIsUndefined Ident+  | UndefinedTypeVariable (ProperName 'TypeName)+  | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))+  | EscapedSkolem Text (Maybe SourceSpan) SourceType+  | TypesDoNotUnify SourceType SourceType+  | KindsDoNotUnify SourceType SourceType+  | ConstrainedTypeUnified SourceType SourceType+  | OverlappingInstances (Qualified (ProperName 'ClassName)) [SourceType] [Qualified Ident]+  | NoInstanceFound SourceConstraint+  | AmbiguousTypeVariables SourceType [Int]+  | UnknownClass (Qualified (ProperName 'ClassName))+  | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [SourceType]+  | PossiblyInfiniteCoercibleInstance+  | CannotDerive (Qualified (ProperName 'ClassName)) [SourceType]+  | InvalidDerivedInstance (Qualified (ProperName 'ClassName)) [SourceType] Int+  | ExpectedTypeConstructor (Qualified (ProperName 'ClassName)) [SourceType] SourceType+  | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [SourceType]+  | MissingNewtypeSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]+  | UnverifiableSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]+  | CannotFindDerivingType (ProperName 'TypeName)+  | DuplicateLabel Label (Maybe Expr)+  | DuplicateValueDeclaration Ident+  | ArgListLengthsDiffer Ident+  | OverlappingArgNames (Maybe Ident)+  | MissingClassMember (NEL.NonEmpty (Ident, SourceType))+  | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))+  | ExpectedType SourceType SourceType+  -- | constructor name, expected argument count, actual argument count+  | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName)) Int Int+  | ExprDoesNotHaveType Expr SourceType+  | PropertyIsMissing Label+  | AdditionalProperty Label+  | OrphanInstance Ident (Qualified (ProperName 'ClassName)) (S.Set ModuleName) [SourceType]+  | InvalidNewtype (ProperName 'TypeName)+  | InvalidInstanceHead SourceType+  | TransitiveExportError DeclarationRef [DeclarationRef]+  | TransitiveDctorExportError DeclarationRef [ProperName 'ConstructorName]+  | HiddenConstructors DeclarationRef (Qualified (ProperName 'ClassName))+  | ShadowedName Ident+  | ShadowedTypeVar Text+  | UnusedTypeVar Text+  | WildcardInferredType SourceType Context+  | HoleInferredType Text SourceType Context (Maybe TypeSearch)+  | MissingTypeDeclaration Ident SourceType+  | MissingKindDeclaration KindSignatureFor (ProperName 'TypeName) SourceType+  | OverlappingPattern [[Binder]] Bool+  | IncompleteExhaustivityCheck+  | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)+  | ImportHidingModule ModuleName+  | UnusedImport ModuleName (Maybe ModuleName)+  | UnusedExplicitImport ModuleName [Name] (Maybe ModuleName) [DeclarationRef]+  | UnusedDctorImport ModuleName (ProperName 'TypeName) (Maybe ModuleName) [DeclarationRef]+  | UnusedDctorExplicitImport ModuleName (ProperName 'TypeName) [ProperName 'ConstructorName] (Maybe ModuleName) [DeclarationRef]+  | DuplicateSelectiveImport ModuleName+  | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)+  | DuplicateImportRef Name+  | DuplicateExportRef Name+  | IntOutOfRange Integer Text Integer Integer+  | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]+  | ImplicitQualifiedImportReExport ModuleName ModuleName [DeclarationRef]+  | ImplicitImport ModuleName [DeclarationRef]+  | HidingImport ModuleName [DeclarationRef]+  | CaseBinderLengthDiffers Int [Binder]+  | IncorrectAnonymousArgument+  | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)+  | CannotGeneralizeRecursiveFunction Ident SourceType+  | CannotDeriveNewtypeForData (ProperName 'TypeName)+  | ExpectedWildcard (ProperName 'TypeName)+  | CannotUseBindWithDo Ident+  -- | instance name, type class, expected argument count, actual argument count+  | ClassInstanceArityMismatch Ident (Qualified (ProperName 'ClassName)) Int Int+  -- | a user-defined warning raised by using the Warn type class+  | UserDefinedWarning SourceType+  -- | a declaration couldn't be used because it contained free variables+  | UnusableDeclaration Ident [[Text]]+  | CannotDefinePrimModules ModuleName+  | MixedAssociativityError (NEL.NonEmpty (Qualified (OpName 'AnyOpName), Associativity))+  | NonAssociativeError (NEL.NonEmpty (Qualified (OpName 'AnyOpName)))+  | QuantificationCheckFailureInKind Text+  | QuantificationCheckFailureInType [Int] SourceType+  | VisibleQuantificationCheckFailureInType Text+  | UnsupportedTypeInKind SourceType+  -- | Declared role was more permissive than inferred.+  | RoleMismatch+      Text -- ^ Type variable in question+      Role -- ^ inferred role+      Role -- ^ declared role+  | InvalidCoercibleInstanceDeclaration [SourceType]+  | UnsupportedRoleDeclaration+  | RoleDeclarationArityMismatch (ProperName 'TypeName) Int Int+  | DuplicateRoleDeclaration (ProperName 'TypeName)+  deriving (Show)++data ErrorMessage = ErrorMessage+  [ErrorMessageHint]+  SimpleErrorMessage+  deriving (Show)+ newtype ErrorSuggestion = ErrorSuggestion Text  -- | Get the source span for an error@@ -77,21 +223,26 @@ -- | Get the error code for a particular error type errorCode :: ErrorMessage -> Text errorCode em = case unwrapErrorMessage em of+  InternalCompilerError{} -> "InternalCompilerError"   ModuleNotFound{} -> "ModuleNotFound"   ErrorParsingFFIModule{} -> "ErrorParsingFFIModule"   ErrorParsingModule{} -> "ErrorParsingModule"   ErrorParsingCSTModule{} -> "ErrorParsingModule"+  WarningParsingCSTModule{} -> "WarningParsingModule"   MissingFFIModule{} -> "MissingFFIModule"   UnnecessaryFFIModule{} -> "UnnecessaryFFIModule"   MissingFFIImplementations{} -> "MissingFFIImplementations"   UnusedFFIImplementations{} -> "UnusedFFIImplementations"   InvalidFFIIdentifier{} -> "InvalidFFIIdentifier"+  DeprecatedFFIPrime{} -> "DeprecatedFFIPrime"   FileIOError{} -> "FileIOError"   InfiniteType{} -> "InfiniteType"   InfiniteKind{} -> "InfiniteKind"   MultipleValueOpFixities{} -> "MultipleValueOpFixities"   MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"   OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"+  OrphanKindDeclaration{} -> "OrphanKindDeclaration"+  OrphanRoleDeclaration{} -> "OrphanRoleDeclaration"   RedefinedIdent{} -> "RedefinedIdent"   OverlappingNamesInLet -> "OverlappingNamesInLet"   UnknownName{} -> "UnknownName"@@ -112,6 +263,7 @@   CycleInDeclaration{} -> "CycleInDeclaration"   CycleInTypeSynonym{} -> "CycleInTypeSynonym"   CycleInTypeClassDeclaration{} -> "CycleInTypeClassDeclaration"+  CycleInKindDeclaration{} -> "CycleInKindDeclaration"   CycleInModules{} -> "CycleInModules"   NameIsUndefined{} -> "NameIsUndefined"   UndefinedTypeVariable{} -> "UndefinedTypeVariable"@@ -125,6 +277,7 @@   AmbiguousTypeVariables{} -> "AmbiguousTypeVariables"   UnknownClass{} -> "UnknownClass"   PossiblyInfiniteInstance{} -> "PossiblyInfiniteInstance"+  PossiblyInfiniteCoercibleInstance -> "PossiblyInfiniteCoercibleInstance"   CannotDerive{} -> "CannotDerive"   InvalidNewtypeInstance{} -> "InvalidNewtypeInstance"   MissingNewtypeSuperclassInstance{} -> "MissingNewtypeSuperclassInstance"@@ -143,18 +296,19 @@   ExprDoesNotHaveType{} -> "ExprDoesNotHaveType"   PropertyIsMissing{} -> "PropertyIsMissing"   AdditionalProperty{} -> "AdditionalProperty"-  TypeSynonymInstance -> "TypeSynonymInstance"   OrphanInstance{} -> "OrphanInstance"   InvalidNewtype{} -> "InvalidNewtype"   InvalidInstanceHead{} -> "InvalidInstanceHead"   TransitiveExportError{} -> "TransitiveExportError"   TransitiveDctorExportError{} -> "TransitiveDctorExportError"+  HiddenConstructors{} -> "HiddenConstructors"   ShadowedName{} -> "ShadowedName"   ShadowedTypeVar{} -> "ShadowedTypeVar"   UnusedTypeVar{} -> "UnusedTypeVar"   WildcardInferredType{} -> "WildcardInferredType"   HoleInferredType{} -> "HoleInferredType"   MissingTypeDeclaration{} -> "MissingTypeDeclaration"+  MissingKindDeclaration{} -> "MissingKindDeclaration"   OverlappingPattern{} -> "OverlappingPattern"   IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"   MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"@@ -185,6 +339,15 @@   CannotDefinePrimModules{} -> "CannotDefinePrimModules"   MixedAssociativityError{} -> "MixedAssociativityError"   NonAssociativeError{} -> "NonAssociativeError"+  QuantificationCheckFailureInKind {} -> "QuantificationCheckFailureInKind"+  QuantificationCheckFailureInType {} -> "QuantificationCheckFailureInType"+  VisibleQuantificationCheckFailureInType {} -> "VisibleQuantificationCheckFailureInType"+  UnsupportedTypeInKind {} -> "UnsupportedTypeInKind"+  RoleMismatch {} -> "RoleMismatch"+  InvalidCoercibleInstanceDeclaration {} -> "InvalidCoercibleInstanceDeclaration"+  UnsupportedRoleDeclaration {} -> "UnsupportedRoleDeclaration"+  RoleDeclarationArityMismatch {} -> "RoleDeclarationArityMismatch"+  DuplicateRoleDeclaration {} -> "DuplicateRoleDeclaration"  -- | A stack trace for an error newtype MultipleErrors = MultipleErrors@@ -264,14 +427,14 @@         put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextIndex = u' + 1 }         return (TUnknown ann u')       Just u' -> return (TUnknown ann u')-  replaceTypes (Skolem ann name s sko) = do+  replaceTypes (Skolem ann name mbK s sko) = do     m <- get     case M.lookup s (umSkolemMap m) of       Nothing -> do         let s' = umNextIndex m         put $ m { umSkolemMap = M.insert s (T.unpack name, s', Just (fst ann)) (umSkolemMap m), umNextIndex = s' + 1 }-        return (Skolem ann name s' sko)-      Just (_, s', _) -> return (Skolem ann name s' sko)+        return (Skolem ann name mbK s' sko)+      Just (_, s', _) -> return (Skolem ann name mbK s' sko)   replaceTypes other = return other  onTypesInErrorMessage :: (SourceType -> SourceType) -> ErrorMessage -> ErrorMessage@@ -300,13 +463,16 @@   gSimple (WildcardInferredType ty ctx) = WildcardInferredType <$> f ty <*> traverse (sndM f) ctx   gSimple (HoleInferredType name ty ctx env) = HoleInferredType name <$> f ty <*> traverse (sndM f) ctx  <*> traverse (onTypeSearchTypesM f) env   gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty+  gSimple (MissingKindDeclaration sig nm ty) = MissingKindDeclaration sig nm <$> f ty   gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty+  gSimple (InvalidCoercibleInstanceDeclaration tys) = InvalidCoercibleInstanceDeclaration <$> traverse f tys   gSimple other = pure other    gHint (ErrorInSubsumption t1 t2) = ErrorInSubsumption <$> f t1 <*> f t2   gHint (ErrorUnifyingTypes t1 t2) = ErrorUnifyingTypes <$> f t1 <*> f t2   gHint (ErrorCheckingType e t) = ErrorCheckingType e <$> f t-  gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t+  gHint (ErrorCheckingKind t k) = ErrorCheckingKind <$> f t <*> f k+  gHint (ErrorInferringKind t) = ErrorInferringKind <$> f t   gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2   gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts   gHint (ErrorSolvingConstraint con) = ErrorSolvingConstraint <$> overConstraintArgs (traverse f) con@@ -330,8 +496,21 @@       ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)       ImplicitQualifiedImportReExport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)       HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing-      MissingTypeDeclaration ident ty -> suggest $ showIdent ident <> " :: " <> T.pack (prettyPrintSuggestedType ty)-      WildcardInferredType ty _ -> suggest $ T.pack (prettyPrintSuggestedType ty)+      MissingTypeDeclaration ident ty -> suggest $ showIdent ident <> " :: " <> T.pack (prettyPrintSuggestedTypeSimplified ty) <> "\n"+      MissingKindDeclaration sig name ty -> suggest $ prettyPrintKindSignatureFor sig <> " " <> runProperName name <> " :: " <> T.pack (prettyPrintSuggestedTypeSimplified ty) <> "\n"+      WildcardInferredType ty _ -> suggest $ T.pack (prettyPrintSuggestedTypeSimplified ty)+      WarningParsingCSTModule pe -> do+        let toks = CST.errToks pe+        case CST.errType pe of+          CST.WarnDeprecatedRowSyntax -> do+            let kind = CST.printTokens $ drop 1 toks+                sugg | T.isPrefixOf " " kind = "Row" <> kind+                     | otherwise = "Row " <> kind+            suggest sugg+          CST.WarnDeprecatedForeignKindSyntax -> suggest $ "data " <> CST.printTokens (drop 3 toks)+          CST.WarnDeprecatedConstraintInForeignImportSyntax -> Nothing+          CST.WarnDeprecatedKindImportSyntax -> suggest $ CST.printTokens $ drop 1 toks+          CST.WarnDeprecatedKindExportSyntax -> suggest $ CST.printTokens $ drop 1 toks       _ -> Nothing   where     emptySuggestion = Just $ ErrorSuggestion ""@@ -357,6 +536,7 @@     getSpan simple ss =       case simple of         MissingTypeDeclaration{} -> startOnly ss+        MissingKindDeclaration{} -> startOnly ss         _ -> ss  showSuggestion :: SimpleErrorMessage -> Text@@ -365,8 +545,8 @@   _ -> ""  ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String-ansiColor (intesity, color) =-   ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intesity color]+ansiColor (intensity, color) =+   ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intensity color]  ansiColorReset :: String ansiColorReset =@@ -391,7 +571,7 @@         ]  --- | Default color intesity and color for code+-- | Default color intensity and color for code defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color) defaultCodeColor = (ANSI.Dull, ANSI.Yellow) @@ -455,6 +635,12 @@       unknownInfo u = line $ markCode ("t" <> T.pack (show u)) <> " is an unknown type"      renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box+    renderSimpleErrorMessage (InternalCompilerError ctx err) =+      paras [ line "Internal compiler error:"+            , indent $ line err+            , line ctx+            , line "Please report this at https://github.com/purescript/purescript/issues"+            ]     renderSimpleErrorMessage (ModuleNotFound mn) =       paras [ line $ "Module " <> markCode (runModuleName mn) <> " was not found."             , line $@@ -481,6 +667,9 @@       paras [ line "Unable to parse module: "             , line $ T.pack $ CST.prettyPrintErrorMessage err             ]+    renderSimpleErrorMessage (WarningParsingCSTModule err) =+      paras [ line $ T.pack $ CST.prettyPrintWarningMessage err+            ]     renderSimpleErrorMessage (MissingFFIModule mn) =       line $ "The foreign module implementation for module " <> markCode (runModuleName mn) <> " is missing."     renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =@@ -503,6 +692,13 @@                 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."                 ]             ]+    renderSimpleErrorMessage (DeprecatedFFIPrime mn ident) =+      paras [ line $ "In the FFI module for " <> markCode (runModuleName mn) <> ":"+            , indent . paras $+                [ line $ "The identifier " <> markCode ident <> " contains a prime (" <> markCode "'" <> ")."+                , line $ "Primes in identifiers exported from FFI modules are deprecated and won’t be supported in the future."+                ]+            ]     renderSimpleErrorMessage InvalidDoBind =       line "The last statement in a 'do' block must be an expression, but this block ends with a binder."     renderSimpleErrorMessage InvalidDoLet =@@ -511,11 +707,11 @@       line "The same name was used more than once in a let binding."     renderSimpleErrorMessage (InfiniteType ty) =       paras [ line "An infinite type was inferred for an expression: "-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             ]     renderSimpleErrorMessage (InfiniteKind ki) =       paras [ line "An infinite kind was inferred for a type: "-            , indent $ line $ markCode $ prettyPrintKind ki+            , markCodeBox $ indent $ prettyType ki             ]     renderSimpleErrorMessage (MultipleValueOpFixities op) =       line $ "There are multiple fixity/precedence declarations for operator " <> markCode (showOp op)@@ -523,10 +719,16 @@       line $ "There are multiple fixity/precedence declarations for type operator " <> markCode (showOp op)     renderSimpleErrorMessage (OrphanTypeDeclaration nm) =       line $ "The type declaration for " <> markCode (showIdent nm) <> " should be followed by its definition."+    renderSimpleErrorMessage (OrphanKindDeclaration nm) =+      line $ "The kind declaration for " <> markCode (runProperName nm) <> " should be followed by its definition."+    renderSimpleErrorMessage (OrphanRoleDeclaration nm) =+      line $ "The role declaration for " <> markCode (runProperName nm) <> " should follow its definition."     renderSimpleErrorMessage (RedefinedIdent name) =       line $ "The value " <> markCode (showIdent name) <> " has been defined multiple times"     renderSimpleErrorMessage (UnknownName name@(Qualified Nothing (IdentName (Ident i)))) | i `elem` [ C.bind, C.discard ] =       line $ "Unknown " <> printName name <> ". You're probably using do-notation, which the compiler replaces with calls to the " <> markCode i <> " function. Please import " <> markCode i <> " from module " <> markCode "Prelude"+    renderSimpleErrorMessage (UnknownName name@(Qualified Nothing (IdentName (Ident i)))) | i == C.negate =+      line $ "Unknown " <> printName name <> ". You're probably using numeric negation (the unary " <> markCode "-" <> " operator), which the compiler replaces with calls to the " <> markCode i <> " function. Please import " <> markCode i <> " from module " <> markCode "Prelude"     renderSimpleErrorMessage (UnknownName name) =       line $ "Unknown " <> printName name     renderSimpleErrorMessage (UnknownImport mn name) =@@ -574,13 +776,18 @@           paras [ line "There is a cycle in module dependencies in these modules: "                 , indent $ paras (map (line . markCode . runModuleName) mns)                 ]-    renderSimpleErrorMessage (CycleInTypeSynonym name) =-      paras [ line $ case name of-                       Just pn -> "A cycle appears in the definition of type synonym " <> markCode (runProperName pn)-                       Nothing -> "A cycle appears in a set of type synonym definitions."-            , line "Cycles are disallowed because they can lead to loops in the type checker."+    renderSimpleErrorMessage (CycleInTypeSynonym names) =+      paras $ cycleError <>+            [ line "Cycles are disallowed because they can lead to loops in the type checker."             , line "Consider using a 'newtype' instead."             ]+      where+      cycleError = case names of+        []   -> pure . line $ "A cycle appears in a set of type synonym definitions."+        [pn] -> pure . line $ "A cycle appears in the definition of type synonym " <> markCode (runProperName pn)+        _    -> [ line " A cycle appears in a set of type synonym definitions:"+                , indent $ line $ "{" <> (T.intercalate ", " (map (markCode . runProperName) names)) <> "}"+                ]     renderSimpleErrorMessage (CycleInTypeClassDeclaration [name]) =       paras [ line $ "A type class '" <> markCode (runProperName (disqualify name)) <> "' may not have itself as a superclass." ]     renderSimpleErrorMessage (CycleInTypeClassDeclaration names) =@@ -588,6 +795,13 @@             , indent $ line $ "{" <> (T.intercalate ", " (map (markCode . runProperName . disqualify) names)) <> "}"             , line "Cycles are disallowed because they can lead to loops in the type checker."             ]+    renderSimpleErrorMessage (CycleInKindDeclaration [name]) =+      paras [ line $ "A kind declaration '" <> markCode (runProperName (disqualify name)) <> "' may not refer to itself in its own signature." ]+    renderSimpleErrorMessage (CycleInKindDeclaration names) =+      paras [ line $ "A cycle appears in a set of kind declarations:"+            , indent $ line $ "{" <> (T.intercalate ", " (map (markCode . runProperName . disqualify) names)) <> "}"+            , line "Kind declarations may not refer to themselves in their own signatures."+            ]     renderSimpleErrorMessage (NameIsUndefined ident) =       line $ "Value " <> markCode (showIdent ident) <> " is undefined."     renderSimpleErrorMessage (UndefinedTypeVariable name) =@@ -598,13 +812,13 @@             ]     renderSimpleErrorMessage (EscapedSkolem name Nothing ty) =       paras [ line $ "The type variable " <> markCode name <> " has escaped its scope, appearing in the type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             ]     renderSimpleErrorMessage (EscapedSkolem name (Just srcSpan) ty) =       paras [ line $ "The type variable " <> markCode name <> ", bound at"             , indent $ line $ displaySourceSpan relPath srcSpan             , line "has escaped its scope, appearing in the type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             ]     renderSimpleErrorMessage (TypesDoNotUnify u1 u2)       = let (row1Box, row2Box) = printRows u1 u2@@ -617,22 +831,22 @@      renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =       paras [ line "Could not match kind"-            , indent $ line $ markCode $ prettyPrintKind k1+            , markCodeBox $ indent $ prettyType k1             , line "with kind"-            , indent $ line $ markCode $ prettyPrintKind k2+            , markCodeBox $ indent $ prettyType k2             ]     renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =       paras [ line "Could not match constrained type"-            , markCodeBox $ indent $ typeAsBox prettyDepth t1+            , markCodeBox $ indent $ prettyType t1             , line "with type"-            , markCodeBox $ indent $ typeAsBox prettyDepth t2+            , markCodeBox $ indent $ prettyType t2             ]     renderSimpleErrorMessage (OverlappingInstances _ _ []) = internalError "OverlappingInstances: empty instance list"     renderSimpleErrorMessage (OverlappingInstances nm ts ds) =       paras [ line "Overlapping type class instances found for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line "The following instances were found:"             , indent $ paras (map (line . showQualified showIdent) ds)@@ -642,12 +856,13 @@             , markCodeBox $ indent $ line (showQualified runProperName nm)             , line "because the class was not in scope. Perhaps it was not exported."             ]-    renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Fail [ ty ] _)) | Just box <- toTypelevelString ty =+    renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Fail _ [ ty ] _)) | Just box <- toTypelevelString ty =       paras [ line "A custom type error occurred while solving type class constraints:"             , indent box             ]     renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Partial                                                           _+                                                          _                                                           (Just (PartialConstraintData bs b)))) =       paras [ line "A case expression could not be determined to cover all inputs."             , line "The following additional cases are required to cover all inputs:"@@ -657,17 +872,17 @@                   : [line "..." | not b]             , line "Alternatively, add a Partial constraint to the type of the enclosing value."             ]-    renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Discard [ty] _)) =+    renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Discard _ [ty] _)) =       paras [ line "A result of type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             , line "was implicitly discarded in a do notation block."             , line ("You can use " <> markCode "_ <- ..." <> " to explicitly discard the result.")             ]-    renderSimpleErrorMessage (NoInstanceFound (Constraint _ nm ts _)) =+    renderSimpleErrorMessage (NoInstanceFound (Constraint _ nm _ ts _)) =       paras [ line "No type class instance was found for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."                     | any containsUnknowns ts@@ -681,7 +896,7 @@         go _ = False     renderSimpleErrorMessage (AmbiguousTypeVariables t us) =       paras [ line "The inferred type"-            , markCodeBox $ indent $ typeAsBox prettyDepth t+            , markCodeBox $ indent $ prettyType t             , line "has type variables which are not determined by those mentioned in the body of the type:"             , indent $ Box.hsep 1 Box.left               [ Box.vcat Box.left@@ -694,15 +909,17 @@       paras [ line "Type class instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line "is possibly infinite."             ]+    renderSimpleErrorMessage PossiblyInfiniteCoercibleInstance =+      line $ "A " <> markCode "Coercible" <> " instance is possibly infinite."     renderSimpleErrorMessage (CannotDerive nm ts) =       paras [ line "Cannot derive a type class instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line "since instances of this type class are not derivable."             ]@@ -710,7 +927,7 @@       paras [ line "Cannot derive newtype instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line "Make sure this is a newtype."             ]@@ -718,7 +935,7 @@       paras [ line "The derived newtype instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName cl)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line $ "does not include a derived superclass instance for " <> markCode (showQualified runProperName su) <> "."             ]@@ -726,7 +943,7 @@       paras [ line "The derived newtype instance for"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName cl)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line $ "implies an superclass instance for " <> markCode (showQualified runProperName su) <> " which could not be verified."             ]@@ -734,7 +951,7 @@       paras [ line "Cannot derive the type class instance"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , line $ fold $                 [ "because the "@@ -750,10 +967,10 @@       paras [ line "Cannot derive the type class instance"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , "because the type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             , line "is not of the required form T a_1 ... a_n, where T is a type constructor defined in the same module."             ]     renderSimpleErrorMessage (CannotFindDerivingType nm) =@@ -774,17 +991,17 @@     renderSimpleErrorMessage (MissingClassMember identsAndTypes) =       paras $ [ line "The following type class members have not been implemented:"               , Box.vcat Box.left-                [ markCodeBox $ Box.text (T.unpack (showIdent ident)) Box.<> " :: " Box.<> typeAsBox prettyDepth ty+                [ markCodeBox $ Box.text (T.unpack (showIdent ident)) Box.<> " :: " Box.<> prettyType ty                 | (ident, ty) <- NEL.toList identsAndTypes ]               ]     renderSimpleErrorMessage (ExtraneousClassMember ident className) =       line $ "" <> markCode (showIdent ident) <> " is not a member of type class " <> markCode (showQualified runProperName className)     renderSimpleErrorMessage (ExpectedType ty kind) =-      paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode (prettyPrintKind kindType) <> "."+      paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode C.typ <> "."             , line "The error arises from the type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             , line "having the kind"-            , indent $ line $ markCode $ prettyPrintKind kind+            , markCodeBox $ indent $ prettyType kind             , line "instead."             ]     renderSimpleErrorMessage (IncorrectConstructorArity nm expected actual) =@@ -795,19 +1012,17 @@       paras [ line "Expression"             , markCodeBox $ indent $ prettyPrintValue prettyDepth expr             , line "does not have type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             ]     renderSimpleErrorMessage (PropertyIsMissing prop) =       line $ "Type of expression lacks required label " <> markCode (prettyPrintLabel prop) <> "."     renderSimpleErrorMessage (AdditionalProperty prop) =       line $ "Type of expression contains additional label " <> markCode (prettyPrintLabel prop) <> "."-    renderSimpleErrorMessage TypeSynonymInstance =-      line "Type class instances for type synonyms are disallowed."     renderSimpleErrorMessage (OrphanInstance nm cnm nonOrphanModules ts) =       paras [ line $ "Orphan instance " <> markCode (showIdent nm) <> " found for "             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName cnm)-                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)+                , Box.vcat Box.left (map prettyTypeAtom ts)                 ]             , Box.vcat Box.left $ case modulesToList of                 [] -> [ line "There is nowhere this instance can be placed without being an orphan."@@ -827,17 +1042,21 @@             ]     renderSimpleErrorMessage (InvalidInstanceHead ty) =       paras [ line "Type class instance head is invalid due to use of type"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             , line "All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form, unless the type is fully determined by other type class arguments via functional dependencies."             ]     renderSimpleErrorMessage (TransitiveExportError x ys) =       paras [ line $ "An export for " <> markCode (prettyPrintExport x) <> " requires the following to also be exported: "             , indent $ paras $ map (line . markCode . prettyPrintExport) ys             ]-    renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =-      paras [ line $ "An export for " <> markCode (prettyPrintExport x) <> " requires the following data constructor to also be exported: "-            , indent $ line $ markCode $ runProperName ctor+    renderSimpleErrorMessage (TransitiveDctorExportError x ctors) =+      paras [ line $ "An export for " <> markCode (prettyPrintExport x) <> " requires the following data constructor" <> (if length ctors == 1 then "" else "s") <> " to also be exported: "+            , indent $ paras $ map (line . markCode . runProperName) ctors             ]+    renderSimpleErrorMessage (HiddenConstructors x className) =+      paras [ line $ "An export for " <> markCode (prettyPrintExport x) <> " hides data constructors but the type declares an instance of " <> markCode (showQualified runProperName className) <> "."+            , line "Such instance allows to match and construct values of this type, effectively making the constructors public."+            ]     renderSimpleErrorMessage (ShadowedName nm) =       line $ "Name " <> markCode (showIdent nm) <> " was shadowed."     renderSimpleErrorMessage (ShadowedTypeVar tv) =@@ -852,7 +1071,7 @@             ]     renderSimpleErrorMessage (WildcardInferredType ty ctx) =       paras $ [ line "Wildcard type definition has the inferred type "-              , markCodeBox $ indent $ typeAsBox prettyDepth ty+              , markCodeBox $ indent $ prettyType ty               ] <> renderContext ctx     renderSimpleErrorMessage (HoleInferredType name ty ctx ts) =       let@@ -864,7 +1083,7 @@                 let                   idBoxes = Box.text . T.unpack . showQualified id <$> names                   tyBoxes = (\t -> BoxHelpers.indented-                              (Box.text ":: " Box.<> typeAsBox prettyDepth t)) <$> types+                              (Box.text ":: " Box.<> prettyType t)) <$> types                   longestId = maximum (map Box.cols idBoxes)                 in                   Box.vcat Box.top $@@ -877,14 +1096,23 @@           _ -> []       in         paras $ [ line $ "Hole '" <> markCode name <> "' has the inferred type "-                , markCodeBox (indent (typeAsBox maxBound ty))+                , markCodeBox (indent (prettyTypeWithDepth maxBound ty))                 ] ++ tsResult ++ renderContext ctx     renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =       paras [ line $ "No type declaration was provided for the top-level declaration of " <> markCode (showIdent ident) <> "."             , line "It is good practice to provide type declarations as a form of documentation."             , line $ "The inferred type of " <> markCode (showIdent ident) <> " was:"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyTypeWithDepth maxBound ty             ]+    renderSimpleErrorMessage (MissingKindDeclaration sig name ty) =+      let sigKw = prettyPrintKindSignatureFor sig in+      paras [ line $ "The inferred kind for the " <> sigKw <> " declaration " <> markCode (runProperName name) <> " contains polymorphic kinds."+            , line $ "Consider adding a top-level kind signature as a form of documentation."+            , markCodeBox $ indent $ Box.hsep 1 Box.left+                [ line $ sigKw <> " " <> runProperName name <> " ::"+                , prettyTypeWithDepth maxBound ty+                ]+            ]     renderSimpleErrorMessage (OverlappingPattern bs b) =       paras $ [ line "A case expression contains unreachable cases:\n"               , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))@@ -976,7 +1204,7 @@     renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =       paras [ line $ "Unable to generalize the type of the recursive function " <> markCode (showIdent ident) <> "."             , line $ "The inferred type of " <> markCode (showIdent ident) <> " was:"-            , markCodeBox $ indent $ typeAsBox prettyDepth ty+            , markCodeBox $ indent $ prettyType ty             , line "Try adding a type signature."             ] @@ -1002,7 +1230,7 @@           argsMsg = if expected > 1 then "arguments" else "argument"      renderSimpleErrorMessage (UserDefinedWarning msgTy) =-      let msg = fromMaybe (typeAsBox prettyDepth msgTy) (toTypelevelString msgTy) in+      let msg = fromMaybe (prettyType msgTy) (toTypelevelString msgTy) in       paras [ line "A custom warning occurred while solving type class constraints:"             , indent msg             ]@@ -1050,6 +1278,76 @@             , line "Use parentheses to resolve this ambiguity."             ] +    renderSimpleErrorMessage (QuantificationCheckFailureInKind var) =+      paras+        [ line $ "Cannot generalize the kind of type variable " <> markCode var <> " since it would not be well-scoped."+        , line "Try adding a kind annotation."+        ]++    renderSimpleErrorMessage (QuantificationCheckFailureInType us ty) =+      let unks =+            fmap (\u -> Box.hsep 1 Box.top [ "where"+                                           , markCodeBox (prettyType (srcTUnknown u))+                                           , "is an unknown kind."+                                           ]) us+      in paras+           [ line "Cannot unambiguously generalize kinds appearing in the elaborated type:"+           , indent $ markCodeBox $ typeAsBox prettyDepth ty+           , paras unks+           , line "Try adding additional kind signatures or polymorphic kind variables."+           ]++    renderSimpleErrorMessage (VisibleQuantificationCheckFailureInType var) =+      paras+        [ line $ "Visible dependent quantification of type variable " <> markCode var <> " is not supported."+        , line $ "If you would like this feature supported, please bother Liam Goodacre (@LiamGoodacre)."+        ]++    renderSimpleErrorMessage (UnsupportedTypeInKind ty) =+      paras+        [ line "The type:"+        , indent $ markCodeBox $ prettyType ty+        , line "is not supported in kinds."+        ]++    renderSimpleErrorMessage (RoleMismatch var inferred declared) =+      paras+        [ line $ "Role mismatch for the type parameter " <> markCode var <> ":"+        , indent . line $+            "The annotation says " <> markCode (displayRole declared) <>+            " but the role " <> markCode (displayRole inferred) <>+            " is required."+        ]++    renderSimpleErrorMessage (InvalidCoercibleInstanceDeclaration tys) =+      paras+        [ line "Invalid type class instance declaration for"+        , markCodeBox $ indent $ Box.hsep 1 Box.left+            [ line (showQualified runProperName C.Coercible)+            , Box.vcat Box.left (map prettyTypeAtom tys)+            ]+        , line "Instance declarations of this type class are disallowed."+        ]++    renderSimpleErrorMessage UnsupportedRoleDeclaration =+      line $ "Role declarations are only supported for data types, not for type synonyms nor type classes."++    renderSimpleErrorMessage (RoleDeclarationArityMismatch name expected actual) =+      line $ T.intercalate " "+        [ "The type"+        , markCode (runProperName name)+        , "expects"+        , T.pack (show expected)+        , if expected == 1 then "argument" else "arguments"+        , "but its role declaration lists"+            <> if actual > expected then "" else " only"+        , T.pack (show actual)+        , if actual > 1 then "roles" else "role"+        ] <> "."++    renderSimpleErrorMessage (DuplicateRoleDeclaration name) =+      line $ "Duplicate role declaration for " <> markCode (runProperName name) <> "."+     renderHint :: ErrorMessageHint -> Box.Box -> Box.Box     renderHint (ErrorUnifyingTypes t1@RCons{} t2@RCons{}) detail =       let (row1Box, row2Box) = printRows t1 t2@@ -1097,12 +1395,21 @@                , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                ]             ]-    renderHint (ErrorCheckingKind ty) detail =+    renderHint (ErrorCheckingKind ty kd) detail =       paras [ detail-            , Box.hsep 1 Box.top [ line "while checking the kind of"+            , Box.hsep 1 Box.top [ line "while checking that type"                                  , markCodeBox $ typeAsBox prettyDepth ty                                  ]+            , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has kind"+                                                   , markCodeBox $ typeAsBox prettyDepth kd+                                                   ]             ]+    renderHint (ErrorInferringKind ty) detail =+      paras [ detail+            , Box.hsep 1 Box.top [ line "while inferring the kind of"+                                 , markCodeBox $ typeAsBox prettyDepth ty+                                 ]+            ]     renderHint ErrorCheckingGuard detail =       paras [ detail             , line "while checking the type of a guard clause"@@ -1172,11 +1479,19 @@       paras [ detail             , line $ "in type class declaration for " <> markCode (runProperName name)             ]+    renderHint (ErrorInKindDeclaration name) detail =+      paras [ detail+            , line $ "in kind declaration for " <> markCode (runProperName name)+            ]+    renderHint (ErrorInRoleDeclaration name) detail =+      paras [ detail+            , line $ "in role declaration for " <> markCode (runProperName name)+            ]     renderHint (ErrorInForeignImport nm) detail =       paras [ detail             , line $ "in foreign import " <> markCode (showIdent nm)             ]-    renderHint (ErrorSolvingConstraint (Constraint _ nm ts _)) detail =+    renderHint (ErrorSolvingConstraint (Constraint _ nm _ ts _)) detail =       paras [ detail             , line "while solving type class constraint"             , markCodeBox $ indent $ Box.hsep 1 Box.left@@ -1184,6 +1499,11 @@                 , Box.vcat Box.left (map (typeAtomAsBox prettyDepth) ts)                 ]             ]+    renderHint (MissingConstructorImportForCoercible name) detail =+      paras+        [ detail+        , Box.moveUp 1 $ Box.moveRight 2 $ line $ "Solving this instance requires the newtype constructor " <> markCode (showQualified runProperName name) <> " to be in scope."+        ]     renderHint (PositionedError srcSpan) detail =       paras [ line $ "at " <> displaySourceSpan relPath (NEL.head srcSpan)             , detail@@ -1195,13 +1515,13 @@     -- If both rows are not empty, print them as diffs     -- If verbose print all rows else only print unique rows     printRows :: Type a -> Type a -> (Box.Box, Box.Box)-    printRows r1 r2 = case (full, r1, r2) of +    printRows r1 r2 = case (full, r1, r2) of       (True, _ , _) -> (printRow typeAsBox r1, printRow typeAsBox r2) -      (_, RCons{}, RCons{}) -> +      (_, RCons{}, RCons{}) ->         let (sorted1, sorted2) = filterRows (rowToList r1) (rowToList r2)         in (printRow typeDiffAsBox sorted1, printRow typeDiffAsBox sorted2)-        +       (_, _, _) -> (printRow typeAsBox r1, printRow typeAsBox r2)  @@ -1239,7 +1559,6 @@     nameType (DctorName _) = "data constructor"     nameType (TyClassName _) = "type class"     nameType (ModName _) = "module"-    nameType (KiName _) = "kind"      runName :: Qualified Name -> Text     runName (Qualified mn (IdentName name)) =@@ -1254,8 +1573,6 @@       showQualified runProperName (Qualified mn name)     runName (Qualified mn (TyClassName name)) =       showQualified runProperName (Qualified mn name)-    runName (Qualified mn (KiName name)) =-      showQualified runProperName (Qualified mn name)     runName (Qualified Nothing (ModName name)) =       runModuleName name     runName (Qualified _ ModName{}) =@@ -1265,6 +1582,19 @@   prettyDepth | full = 1000               | otherwise = 3 +  prettyType :: Type a -> Box.Box+  prettyType = prettyTypeWithDepth prettyDepth++  prettyTypeWithDepth :: Int -> Type a -> Box.Box+  prettyTypeWithDepth depth+    | full = typeAsBox depth+    | otherwise = typeAsBox depth . eraseForAllKindAnnotations . eraseKindApps++  prettyTypeAtom :: Type a -> Box.Box+  prettyTypeAtom+    | full = typeAtomAsBox prettyDepth+    | otherwise = typeAtomAsBox prettyDepth . eraseForAllKindAnnotations . eraseKindApps+   levelText :: Text   levelText = case level of     Error -> "error"@@ -1279,7 +1609,7 @@     where     -- Take the last instance of each "hint category"     simplifyHints :: [ErrorMessageHint] -> [ErrorMessageHint]-    simplifyHints = reverse . nubBy categoriesEqual . stripRedudantHints simple . reverse+    simplifyHints = reverse . nubBy categoriesEqual . stripRedundantHints simple . reverse      -- Don't remove hints in the "other" category     categoriesEqual :: ErrorMessageHint -> ErrorMessageHint -> Bool@@ -1290,20 +1620,24 @@         (c1, c2) -> c1 == c2      -- | See https://github.com/purescript/purescript/issues/1802-    stripRedudantHints :: SimpleErrorMessage -> [ErrorMessageHint] -> [ErrorMessageHint]-    stripRedudantHints ExprDoesNotHaveType{} = stripFirst isCheckHint+    stripRedundantHints :: SimpleErrorMessage -> [ErrorMessageHint] -> [ErrorMessageHint]+    stripRedundantHints ExprDoesNotHaveType{} = stripFirst isCheckHint       where       isCheckHint ErrorCheckingType{} = True       isCheckHint _ = False-    stripRedudantHints TypesDoNotUnify{} = stripFirst isUnifyHint+    stripRedundantHints TypesDoNotUnify{} = stripFirst isUnifyHint       where       isUnifyHint ErrorUnifyingTypes{} = True       isUnifyHint _ = False-    stripRedudantHints NoInstanceFound{} = stripFirst isSolverHint+    stripRedundantHints (NoInstanceFound (Constraint _ C.Coercible _ args _)) = filter (not . isSolverHint)       where+      isSolverHint (ErrorSolvingConstraint (Constraint _ C.Coercible _ args' _)) = args == args'+      isSolverHint _ = False+    stripRedundantHints NoInstanceFound{} = stripFirst isSolverHint+      where       isSolverHint ErrorSolvingConstraint{} = True       isSolverHint _ = False-    stripRedudantHints _ = id+    stripRedundantHints _ = id      stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]     stripFirst p (PositionedError pos : hs) = PositionedError pos : stripFirst p hs@@ -1360,11 +1694,18 @@   Just $ showIdent ident prettyPrintRef (ModuleRef _ name) =   Just $ "module " <> runModuleName name-prettyPrintRef (KindRef _ pn) =-  Just $ "kind " <> runProperName pn prettyPrintRef ReExportRef{} =   Nothing +prettyPrintKindSignatureFor :: KindSignatureFor -> Text+prettyPrintKindSignatureFor DataSig = "data"+prettyPrintKindSignatureFor NewtypeSig = "newtype"+prettyPrintKindSignatureFor TypeSynonymSig = "type"+prettyPrintKindSignatureFor ClassSig = "class"++prettyPrintSuggestedTypeSimplified :: Type a -> String+prettyPrintSuggestedTypeSimplified = prettyPrintSuggestedType . eraseForAllKindAnnotations . eraseKindApps+ -- | Pretty print multiple errors prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions@@ -1544,3 +1885,12 @@     collectErrors es = case partitionEithers es of       ([], rs) -> return rs       (errs, _) -> throwError $ fold errs++internalCompilerError+  :: (MonadError MultipleErrors m, GHC.Stack.HasCallStack)+  => Text+  -> m a+internalCompilerError =+  throwError+    . errorMessage+    . InternalCompilerError (T.pack (GHC.Stack.prettyCallStack GHC.Stack.callStack))
src/Language/PureScript/Errors/JSON.hs view
@@ -6,7 +6,6 @@  import qualified Data.Aeson.TH as A import qualified Data.List.NonEmpty as NEL-import qualified Data.Text as T import Data.Text (Text)  import qualified Language.PureScript as P@@ -73,5 +72,4 @@       Nothing -> Nothing       Just s -> Just $ ErrorSuggestion (suggestionText s) (toErrorPosition <$> P.suggestionSpan em) -  -- TODO: Adding a newline because source spans chomp everything up to the next character-  suggestionText (P.ErrorSuggestion s) = if T.null s then s else s <> "\n"+  suggestionText (P.ErrorSuggestion s) = s
src/Language/PureScript/Externs.hs view
@@ -27,13 +27,11 @@ import qualified Data.Text as T import Data.Version (showVersion) import qualified Data.Map as M-import qualified Data.Set as S import qualified Data.List.NonEmpty as NEL  import Language.PureScript.AST import Language.PureScript.Crash import Language.PureScript.Environment-import Language.PureScript.Kinds import Language.PureScript.Names import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types@@ -113,16 +111,16 @@   -- | A type declaration     EDType       { edTypeName                :: ProperName 'TypeName-      , edTypeKind                :: SourceKind+      , edTypeKind                :: SourceType       , edTypeDeclarationKind     :: TypeKind       }   -- | A type synonym   | EDTypeSynonym       { edTypeSynonymName         :: ProperName 'TypeName-      , edTypeSynonymArguments    :: [(Text, Maybe SourceKind)]+      , edTypeSynonymArguments    :: [(Text, Maybe SourceType)]       , edTypeSynonymType         :: SourceType       }-  -- | A data construtor+  -- | A data constructor   | EDDataConstructor       { edDataCtorName            :: ProperName 'ConstructorName       , edDataCtorOrigin          :: DataDeclType@@ -138,7 +136,7 @@   -- | A type class declaration   | EDClass       { edClassName               :: ProperName 'ClassName-      , edClassTypeArguments      :: [(Text, Maybe SourceKind)]+      , edClassTypeArguments      :: [(Text, Maybe SourceType)]       , edClassMembers            :: [(Ident, SourceType)]       , edClassConstraints        :: [SourceConstraint]       , edFunctionalDependencies  :: [FunctionalDependency]@@ -148,15 +146,13 @@   | EDInstance       { edInstanceClassName       :: Qualified (ProperName 'ClassName)       , edInstanceName            :: Ident+      , edInstanceForAll          :: [(Text, SourceType)]+      , edInstanceKinds           :: [SourceType]       , edInstanceTypes           :: [SourceType]       , edInstanceConstraints     :: Maybe [SourceConstraint]       , edInstanceChain           :: [Qualified Ident]       , edInstanceChainIndex      :: Integer       }-  -- | A kind declaration-  | EDKind-      { edKindName                :: ProperName 'KindName-      }   deriving (Show, Generic)  instance Serialise ExternsDeclaration@@ -177,15 +173,14 @@   applyDecl env (EDDataConstructor pn dTy tNm ty nms) = env { dataConstructors = M.insert (qual pn) (dTy, tNm, ty, nms) (dataConstructors env) }   applyDecl env (EDValue ident ty) = env { names = M.insert (Qualified (Just efModuleName) ident) (ty, External, Defined) (names env) }   applyDecl env (EDClass pn args members cs deps tcIsEmpty) = env { typeClasses = M.insert (qual pn) (makeTypeClassData args members cs deps tcIsEmpty) (typeClasses env) }-  applyDecl env (EDKind pn) = env { kinds = S.insert (qual pn) (kinds env) }-  applyDecl env (EDInstance className ident tys cs ch idx) =+  applyDecl env (EDInstance className ident vars kinds tys cs ch idx) =     env { typeClassDictionaries =             updateMap               (updateMap (M.insertWith (<>) (qual ident) (pure dict)) className)               (Just efModuleName) (typeClassDictionaries env) }     where     dict :: NamedDict-    dict = TypeClassDictionaryInScope ch idx (qual ident) [] className tys cs+    dict = TypeClassDictionaryInScope ch idx (qual ident) [] className vars kinds tys cs      updateMap :: (Ord k, Monoid a) => (a -> a) -> k -> M.Map k a -> M.Map k a     updateMap f = M.alter (Just . f . fold)@@ -230,8 +225,8 @@       Nothing -> internalError "toExternsDeclaration: no kind in toExternsDeclaration"       Just (kind, TypeSynonym)         | Just (args, synTy) <- Qualified (Just mn) pn `M.lookup` typeSynonyms env -> [ EDType pn kind TypeSynonym, EDTypeSynonym pn args synTy ]-      Just (kind, ExternData) -> [ EDType pn kind ExternData ]-      Just (kind, tk@(DataType _ tys)) ->+      Just (kind, ExternData rs) -> [ EDType pn kind (ExternData rs) ]+      Just (kind, tk@(DataType _ _ tys)) ->         EDType pn kind tk : [ EDDataConstructor dctor dty pn ty args                             | dctor <- fromMaybe (map fst tys) dctors                             , (dty, _, ty, args) <- maybeToList (Qualified (Just mn) dctor `M.lookup` dataConstructors env)@@ -241,23 +236,23 @@     | Just (ty, _, _) <- Qualified (Just mn) ident `M.lookup` names env     = [ EDValue ident ty ]   toExternsDeclaration (TypeClassRef _ className)-    | Just TypeClassData{..} <- Qualified (Just mn) className `M.lookup` typeClasses env-    , Just (kind, TypeSynonym) <- Qualified (Just mn) (coerceProperName className) `M.lookup` types env-    , Just (_, synTy) <- Qualified (Just mn) (coerceProperName className) `M.lookup` typeSynonyms env-    = [ EDType (coerceProperName className) kind TypeSynonym-      , EDTypeSynonym (coerceProperName className) typeClassArguments synTy+    | let dictName = dictSynonymName . coerceProperName $ className+    , Just TypeClassData{..} <- Qualified (Just mn) className `M.lookup` typeClasses env+    , Just (kind, ExternData rs) <- Qualified (Just mn) (coerceProperName className) `M.lookup` types env+    , Just (synKind, TypeSynonym) <- Qualified (Just mn) dictName `M.lookup` types env+    , Just (synArgs, synTy) <- Qualified (Just mn) dictName `M.lookup` typeSynonyms env+    = [ EDType (coerceProperName className) kind (ExternData rs)+      , EDType dictName synKind TypeSynonym+      , EDTypeSynonym dictName synArgs synTy       , EDClass className typeClassArguments typeClassMembers typeClassSuperclasses typeClassDependencies typeClassIsEmpty       ]   toExternsDeclaration (TypeInstanceRef _ ident)-    = [ EDInstance tcdClassName ident tcdInstanceTypes tcdDependencies tcdChain tcdIndex+    = [ EDInstance tcdClassName ident tcdForAll tcdInstanceKinds tcdInstanceTypes tcdDependencies tcdChain tcdIndex       | m1 <- maybeToList (M.lookup (Just mn) (typeClassDictionaries env))       , m2 <- M.elems m1       , nel <- maybeToList (M.lookup (Qualified (Just mn) ident) m2)       , TypeClassDictionaryInScope{..} <- NEL.toList nel       ]-  toExternsDeclaration (KindRef _ pn)-    | Qualified (Just mn) pn `S.member` kinds env-    = [ EDKind pn ]   toExternsDeclaration _ = []  externsFileName :: FilePath
src/Language/PureScript/Graph.hs view
@@ -32,7 +32,7 @@   Make.runMake Options.defaultOptions $ do     ms <- CST.parseModulesFromFiles id moduleFiles     let parsedModuleSig = Dependencies.moduleSignature . CST.resPartial-    (_sorted, moduleGraph) <- Dependencies.sortModules (parsedModuleSig . snd) ms+    (_sorted, moduleGraph) <- Dependencies.sortModules Dependencies.Direct (parsedModuleSig . snd) ms     let pathMap = Map.fromList $           map (\(p, m) -> (Dependencies.sigModuleName (parsedModuleSig m), p)) ms     pure (moduleGraphToJSON pathMap moduleGraph)
src/Language/PureScript/Hierarchy.hs view
@@ -80,6 +80,6 @@  superClasses :: P.Declaration -> [SuperMap] superClasses (P.TypeClassDeclaration _ sub _ supers@(_:_) _ _) =-  fmap (\(P.Constraint _ (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers+  fmap (\(P.Constraint _ (P.Qualified _ super) _ _ _) -> SuperMap (Right (super, sub))) supers superClasses (P.TypeClassDeclaration _ sub _ _ _ _) = [SuperMap (Left sub)] superClasses _ = []
src/Language/PureScript/Ide.hs view
@@ -43,7 +43,7 @@ import           System.FilePath ((</>), normalise) import           System.FilePath.Glob (glob) --- | Accepts a Commmand and runs it against psc-ide's State. This is the main+-- | Accepts a Command and runs it against psc-ide's State. This is the main -- entry point for the server. handleCommand   :: (Ide m, MonadLogger m, MonadError IdeError m)
src/Language/PureScript/Ide/CaseSplit.hs view
@@ -44,7 +44,7 @@ noAnnotations :: WildcardAnnotations noAnnotations = WildcardAnnotations False -type DataType = ([(Text, Maybe P.SourceKind)], [(P.ProperName 'P.ConstructorName, [P.SourceType])])+type DataType = ([(Text, Maybe P.SourceType, P.Role)], [(P.ProperName 'P.ConstructorName, [P.SourceType])])  caseSplit   :: (Ide m, MonadError IdeError m)@@ -54,7 +54,7 @@   type' <- parseType' q   (tc, args) <- splitTypeConstructor type'   (typeVars, ctors) <- findTypeDeclaration tc-  let applyTypeVars = P.everywhereOnTypes (P.replaceAllTypeVars (zip (map fst typeVars) args))+  let applyTypeVars = P.everywhereOnTypes (P.replaceAllTypeVars (zip (map (\(name, _, _) -> name) typeVars) args))   let appliedCtors = map (second (map applyTypeVars)) ctors   pure appliedCtors @@ -76,7 +76,7 @@   -> First DataType findTypeDeclaration' t ExternsFile{..} =   First $ head $ mapMaybe (\case-            EDType tn _ (P.DataType typeVars ctors)+            EDType tn _ (P.DataType _ typeVars ctors)               | tn == t -> Just (typeVars, ctors)             _ -> Nothing) efDeclarations @@ -125,14 +125,14 @@               Text -> m P.SourceType parseType' s =   case CST.runTokenParser CST.parseType $ CST.lex s of-    Right type' -> pure $ CST.convertType "<purs-ide>" type'+    Right type' -> pure $ CST.convertType "<purs-ide>" $ snd type'     Left err ->       throwError (GeneralError ("Parsing the splittype failed with:"                                 <> show err))  parseTypeDeclaration' :: (MonadError IdeError m) => Text -> m (P.Ident, P.SourceType) parseTypeDeclaration' s =-  let x = fmap (CST.convertDeclaration "<purs-ide>")+  let x = fmap (CST.convertDeclaration "<purs-ide>" . snd)         $ CST.runTokenParser CST.parseDecl         $ CST.lex s   in
src/Language/PureScript/Ide/Command.hs view
@@ -16,6 +16,7 @@  import           Protolude +import           Control.Monad.Fail (fail) import           Data.Aeson import qualified Data.Map as Map import qualified Data.Set as Set@@ -103,7 +104,7 @@           <$> (o .: "identifier")           <*> (fmap P.moduleNameFromString <$> o .:? "qualifier") -      _ -> mzero+      s -> fail ("Unknown import command: " <> show s)  data ListType = LoadedModules | Imports FilePath | AvailableModules @@ -114,7 +115,7 @@       "import" -> Imports <$> o .: "file"       "loadedModules" -> pure LoadedModules       "availableModules" -> pure AvailableModules-      _ -> mzero+      s -> fail ("Unknown list type: " <> show s)  instance FromJSON Command where   parseJSON = withObject "command" $ \o -> do@@ -175,10 +176,14 @@           <$> params .: "file"           <*> params .:? "actualFile"           <*> (parseCodegenTargets =<< params .:? "codegen" .!= [ "js" ])-      _ -> mzero+      c -> fail ("Unknown command: " <> show c)     where-      parseCodegenTargets =-        maybe mzero (pure . Set.fromList) . traverse (flip Map.lookup P.codegenTargets)+      parseCodegenTargets ts =+        case traverse (\t -> Map.lookup t P.codegenTargets) ts of+          Nothing ->+            fail ("Failed to parse codegen targets: " <> show ts)+          Just ts' ->+            pure (Set.fromList ts')        mkAnnotations True = explicitAnnotations       mkAnnotations False = noAnnotations
src/Language/PureScript/Ide/Completion.hs view
@@ -110,15 +110,14 @@   where     (complIdentifier, complExpandedType) = case decl of       IdeDeclValue v -> (v ^. ideValueIdent . identT, v ^. ideValueType & prettyPrintTypeSingleLine)-      IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & P.prettyPrintKind)+      IdeDeclType t -> (t ^. ideTypeName . properNameT, t ^. ideTypeKind & prettyPrintTypeSingleLine)       IdeDeclTypeSynonym s -> (s ^. ideSynonymName . properNameT, s ^. ideSynonymType & prettyPrintTypeSingleLine)       IdeDeclDataConstructor d -> (d ^. ideDtorName . properNameT, d ^. ideDtorType & prettyPrintTypeSingleLine)-      IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, d ^. ideTCKind & P.prettyPrintKind)+      IdeDeclTypeClass d -> (d ^. ideTCName . properNameT, d ^. ideTCKind & prettyPrintTypeSingleLine)       IdeDeclValueOperator (IdeValueOperator op ref precedence associativity typeP) ->         (P.runOpName op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyPrintTypeSingleLine typeP)       IdeDeclTypeOperator (IdeTypeOperator op ref precedence associativity kind) ->-        (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) P.prettyPrintKind kind)-      IdeDeclKind k -> (P.runProperName k, "kind")+        (P.runOpName op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) prettyPrintTypeSingleLine kind)       IdeDeclModule mn -> (P.runModuleName mn, "module")      complExportedFrom = mns@@ -130,6 +129,8 @@     complLocation = _annLocation ann      complDocumentation = _annDocumentation ann++    complDeclarationType = Just (declarationType decl)      showFixity p a r o =       let asso = case a of
src/Language/PureScript/Ide/Error.hs view
@@ -66,9 +66,27 @@     insertTSCompletions _ _ _ v = v      identCompletion (P.Qualified mn i, ty) =-      Completion (maybe "" P.runModuleName mn) i (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing (maybe [] (\x -> [x]) mn)+      Completion     +        { complModule = maybe "" P.runModuleName mn+        , complIdentifier = i+        , complType = prettyPrintTypeSingleLine ty+        , complExpandedType = prettyPrintTypeSingleLine ty+        , complLocation = Nothing+        , complDocumentation = Nothing+        , complExportedFrom = maybe [] (\x -> [x]) mn+        , complDeclarationType = Nothing+        }     fieldCompletion (label, ty) =-      Completion "" ("_." <> P.prettyPrintLabel label) (prettyPrintTypeSingleLine ty) (prettyPrintTypeSingleLine ty) Nothing Nothing []+      Completion +        { complModule = ""+        , complIdentifier = ("_." <> P.prettyPrintLabel label)+        , complType = prettyPrintTypeSingleLine ty+        , complExpandedType = prettyPrintTypeSingleLine ty+        , complLocation = Nothing+        , complDocumentation = Nothing+        , complExportedFrom = []+        , complDeclarationType = Nothing+        }  textError :: IdeError -> Text textError (GeneralError msg)          = msg
src/Language/PureScript/Ide/Externs.hs view
@@ -1,18 +1,4 @@------------------------------------------------------------------------------------ Module      : Language.PureScript.Ide.Externs--- Description : Handles externs files for psc-ide--- Copyright   : Christoph Hegemann 2016--- License     : MIT (http://opensource.org/licenses/MIT)------ Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>--- Stability   : experimental------ |--- Handles externs files for psc-ide--------------------------------------------------------------------------------{-# LANGUAGE PackageImports  #-}+{-# language PackageImports, BlockArguments #-}  module Language.PureScript.Ide.Externs   ( readExternFile@@ -24,10 +10,12 @@ import           Codec.CBOR.Term as Term import           "monad-logger" Control.Monad.Logger import           Data.Version (showVersion)+import qualified Data.Text as Text import qualified Language.PureScript as P import qualified Language.PureScript.Make.Monad as Make import           Language.PureScript.Ide.Error (IdeError (..)) import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Util (properNameT) import           Lens.Micro.Platform  readExternFile@@ -67,51 +55,40 @@     moduleDecl = IdeDeclarationAnn emptyAnn (IdeDeclModule (P.efModuleName ef))     (toResolve, declarations) =       second catMaybes (partitionEithers (map convertDecl (P.efDeclarations ef)))--    -- It's important that we resolve synonyms first, because that resolving-    -- process removes the corresponding type declarations. This way we don't-    -- leave any stray type declarations for type classes around since they have-    -- already been cleaned up in the type synonym pass.-    resolver = resolveTypeClasses toResolve <> resolveSynonyms toResolve-    resolvedDeclarations = appEndo resolver declarations+    resolvedDeclarations = resolveSynonymsAndClasses toResolve declarations -resolveSynonyms :: [ToResolve] -> Endo [IdeDeclaration]-resolveSynonyms = foldMap resolveSynonym+resolveSynonymsAndClasses+  :: [ToResolve]+  -> [IdeDeclaration]+  -> [IdeDeclaration]+resolveSynonymsAndClasses trs decls = foldr go decls trs   where-    resolveSynonym tr = case tr of-      TypeClassToResolve _ -> mempty-      SynonymToResolve tn ty -> Endo $ \decls ->-        case findType tn decls of-          Nothing -> decls+    go tr acc = case tr of+      TypeClassToResolve tcn ->+        case findType (P.coerceProperName tcn) acc of+          Nothing ->+            acc+          Just tyDecl -> IdeDeclTypeClass+            (IdeTypeClass tcn (tyDecl^.ideTypeKind) [])+            : filter (not . anyOf (_IdeDeclType.ideTypeName) (== P.coerceProperName tcn)) acc+      SynonymToResolve tn ty ->+        case findType tn acc of+          Nothing ->+            acc           Just tyDecl ->             IdeDeclTypeSynonym (IdeTypeSynonym tn ty (tyDecl^.ideTypeKind))-            : filter (not . anyOf (_IdeDeclType.ideTypeName) (== tn)) decls--resolveTypeClasses :: [ToResolve] -> Endo [IdeDeclaration]-resolveTypeClasses = foldMap resolveTypeClass-  where-    resolveTypeClass tr = case tr of-      SynonymToResolve _ _ -> mempty-      TypeClassToResolve tcn -> Endo $ \decls ->-        case findSynonym (P.coerceProperName tcn) decls of-          Nothing -> decls-          Just tySyn -> IdeDeclTypeClass-            (IdeTypeClass tcn (tySyn^.ideSynonymKind) [])-            : filter (not . anyOf (_IdeDeclTypeSynonym.ideSynonymName) (== P.coerceProperName tcn)) decls+            : filter (not . anyOf (_IdeDeclType.ideTypeName) (== tn)) acc  findType :: P.ProperName 'P.TypeName -> [IdeDeclaration] -> Maybe IdeType-findSynonym :: P.ProperName 'P.TypeName -> [IdeDeclaration] -> Maybe IdeTypeSynonym-(findType, findSynonym) = ( findDecl _IdeDeclType ideTypeName-                          , findDecl _IdeDeclTypeSynonym ideSynonymName-                          )-  where-    findDecl p l tn decls = decls-      & mapMaybe (preview p)-      & find ((==) tn . view l)+findType tn decls =+  decls+    & mapMaybe (preview _IdeDeclType)+    & find ((==) tn . view ideTypeName) --- The Externs format splits information about synonyms across EDType and--- EDTypeSynonym declarations. For type classes there are three declarations--- involved. We collect these and resolve them at the end of the conversion process.+-- The Externs format splits information about synonyms across EDType+-- and EDTypeSynonym declarations. For type classes it split them+-- across an EDType and an EDClass . We collect these and resolve them+-- at the end of the conversion process. data ToResolve   = TypeClassToResolve (P.ProperName 'P.ClassName)   | SynonymToResolve (P.ProperName 'P.TypeName) P.SourceType@@ -122,10 +99,16 @@  convertDecl :: P.ExternsDeclaration -> Either ToResolve (Maybe IdeDeclaration) convertDecl ed = case ed of-  P.EDType{..} ->-    Right (Just (IdeDeclType (IdeType edTypeName edTypeKind [])))+  -- We need to filter all types and synonyms that contain a '$'+  -- because those are typechecker internal definitions that shouldn't+  -- be user facing+  P.EDType{..} -> Right do+    guard (isNothing (Text.find (== '$') (edTypeName^.properNameT)))+    Just (IdeDeclType (IdeType edTypeName edTypeKind []))   P.EDTypeSynonym{..} ->-    Left (SynonymToResolve edTypeSynonymName edTypeSynonymType)+    if isNothing (Text.find (== '$') (edTypeSynonymName^.properNameT))+      then Left (SynonymToResolve edTypeSynonymName edTypeSynonymType)+      else Right Nothing   P.EDDataConstructor{..} ->     Right       (Just@@ -135,8 +118,6 @@     Right (Just (IdeDeclValue (IdeValue edValueName edValueType)))   P.EDClass{..} ->     Left (TypeClassToResolve edClassName)-  P.EDKind{..} ->-    Right (Just (IdeDeclKind edKindName))   P.EDInstance{} ->     Right Nothing
src/Language/PureScript/Ide/Filter.hs view
@@ -26,12 +26,13 @@  import           Protolude                     hiding (isPrefixOf, Prefix) +import           Control.Monad.Fail (fail) import           Data.Bifunctor (first) import           Data.Aeson-import           Data.Text                     (isPrefixOf)+import           Data.Text (isPrefixOf) import qualified Data.Set as Set import qualified Data.Map as Map-import           Language.PureScript.Ide.Filter.Declaration (DeclarationType, declarationType)+import           Language.PureScript.Ide.Filter.Declaration (DeclarationType) import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util import qualified Language.PureScript           as P@@ -141,4 +142,4 @@       "declarations" -> do         declarations <- o.: "params"         pure (declarationTypeFilter (Set.fromList declarations))-      _ -> mzero+      s -> fail ("Unknown filter: " <> show s)
src/Language/PureScript/Ide/Filter/Declaration.hs view
@@ -2,13 +2,12 @@  module Language.PureScript.Ide.Filter.Declaration        ( DeclarationType(..)-       , declarationType        ) where  import           Protolude                     hiding (isPrefixOf) +import           Control.Monad.Fail (fail) import           Data.Aeson-import qualified Language.PureScript.Ide.Types as PI  data DeclarationType   = Value@@ -18,7 +17,6 @@   | TypeClass   | ValueOperator   | TypeOperator-  | Kind   | Module   deriving (Show, Eq, Ord) @@ -32,18 +30,16 @@       "typeclass"         -> pure TypeClass       "valueoperator"     -> pure ValueOperator       "typeoperator"      -> pure TypeOperator-      "kind"              -> pure Kind       "module"            -> pure Module-      _                   -> mzero+      s                   -> fail ("Unknown declaration type: " <> show s) -declarationType :: PI.IdeDeclaration -> DeclarationType-declarationType decl = case decl of-  PI.IdeDeclValue _ -> Value-  PI.IdeDeclType _ -> Type-  PI.IdeDeclTypeSynonym _ -> Synonym-  PI.IdeDeclDataConstructor _ -> DataConstructor-  PI.IdeDeclTypeClass _ -> TypeClass-  PI.IdeDeclValueOperator _ -> ValueOperator-  PI.IdeDeclTypeOperator _ -> TypeOperator-  PI.IdeDeclKind _ -> Kind-  PI.IdeDeclModule _ -> Module+instance ToJSON DeclarationType where+  toJSON dt = toJSON $ case dt of+    Value           -> "value" :: Text+    Type            -> "type"+    Synonym         -> "synonym"+    DataConstructor -> "dataconstructor"+    TypeClass       -> "typeclass"+    ValueOperator   -> "valueoperator"+    TypeOperator    -> "typeoperator"+    Module          -> "module"
src/Language/PureScript/Ide/Imports.hs view
@@ -37,7 +37,7 @@ import qualified Data.Map                           as Map import qualified Data.Text                          as T import qualified Language.PureScript                as P-import qualified Language.PureScript.Constants      as C+import qualified Language.PureScript.Constants.Prim as C import qualified Language.PureScript.CST            as CST import           Language.PureScript.Ide.Completion import           Language.PureScript.Ide.Error@@ -222,8 +222,6 @@       P.ValueOpRef ideSpan (op ^. ideValueOpName)     refFromDeclaration (IdeDeclTypeOperator op) =       P.TypeOpRef ideSpan (op ^. ideTypeOpName)-    refFromDeclaration (IdeDeclKind kn) =-      P.KindRef ideSpan kn     refFromDeclaration d =       P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d)) @@ -231,7 +229,7 @@     -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)     insertDeclIntoImport :: IdeDeclaration -> Import -> Import     insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) =-      Import mn (P.Explicit (sortBy P.compDecRef (insertDeclIntoRefs decl' refs))) qual+      Import mn (P.Explicit (sort (insertDeclIntoRefs decl' refs))) qual     insertDeclIntoImport _ is = is      insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]@@ -316,16 +314,13 @@         -- worst         Just decl ->           Right <$> addExplicitImport fp decl m1 qual-        -- Here we need the user to specify whether he wanted a dataconstructor-        -- or a type--        -- TODO: With the new namespace filter, this can actually be a-        -- request for the user to specify which of the two was wanted.+        -- Here we need the user to specify whether they wanted a +        -- dataconstructor or a type         Nothing ->           throwError (GeneralError "Undecidable between type and dataconstructor")      -- Multiple matches were found so we need to ask the user to clarify which-    -- module he meant+    -- module they meant     xs ->       pure (Left xs)     where@@ -371,7 +366,7 @@ -- | Test and ghci helper parseImport :: Text -> Maybe Import parseImport t =-  case fmap (CST.convertImportDecl "<purs-ide>")+  case fmap (CST.convertImportDecl "<purs-ide>" . snd)         $ CST.runTokenParser CST.parseImportDeclP         $ CST.lex t of     Right (_, mn, idt, mmn) ->
src/Language/PureScript/Ide/Matcher.hs view
@@ -24,6 +24,7 @@  import           Protolude +import           Control.Monad.Fail (fail) import           Data.Aeson import qualified Data.Text                     as T import qualified Data.Text.Encoding            as TE@@ -49,7 +50,7 @@         distanceMatcher           <$> params .: "search"           <*> params .: "maximumDistance"-      Just _ -> mzero+      Just s -> fail ("Unknown matcher: " <> show s)       Nothing -> return mempty  -- | Matches any occurrence of the search string with intersections
src/Language/PureScript/Ide/Prim.hs view
@@ -4,34 +4,33 @@  import qualified Data.Text as T import qualified Data.Map as Map-import qualified Data.Set as Set import qualified Language.PureScript as P-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C import qualified Language.PureScript.Environment as PEnv import           Language.PureScript.Ide.Types  idePrimDeclarations :: ModuleMap [IdeDeclarationAnn] idePrimDeclarations = Map.fromList   [ ( C.Prim-    , mconcat [primTypes, primKinds, primClasses]+    , mconcat [primTypes, primClasses]     )   , ( C.PrimBoolean-    , mconcat [primBooleanTypes, primBooleanKinds]+    , mconcat [primBooleanTypes]     )   , ( C.PrimOrdering-    , mconcat [primOrderingTypes, primOrderingKinds]+    , mconcat [primOrderingTypes]     )   , ( C.PrimRow     , mconcat [primRowTypes, primRowClasses]     )   , ( C.PrimRowList-    , mconcat [primRowListTypes, primRowListClasses, primRowListKinds]+    , mconcat [primRowListTypes, primRowListClasses]     )   , ( C.PrimSymbol     , mconcat [primSymbolTypes, primSymbolClasses]     )   , ( C.PrimTypeError-    , mconcat [primTypeErrorTypes, primTypeErrorClasses, primTypeErrorKinds]+    , mconcat [primTypeErrorTypes, primTypeErrorClasses]     )   ]   where@@ -63,18 +62,3 @@     primRowListClasses = annClass PEnv.primRowListClasses     primSymbolClasses = annClass PEnv.primSymbolClasses     primTypeErrorClasses = annClass PEnv.primTypeErrorClasses--    primKinds = foreach (Set.toList PEnv.primKinds) $ \kn ->-      IdeDeclarationAnn emptyAnn (IdeDeclKind (P.disqualify kn))--    primBooleanKinds = foreach (Set.toList PEnv.primBooleanKinds) $ \kn ->-      IdeDeclarationAnn emptyAnn (IdeDeclKind (P.disqualify kn))--    primOrderingKinds = foreach (Set.toList PEnv.primOrderingKinds) $ \kn ->-      IdeDeclarationAnn emptyAnn (IdeDeclKind (P.disqualify kn))--    primRowListKinds = foreach (Set.toList PEnv.primRowListKinds) $ \kn ->-      IdeDeclarationAnn emptyAnn (IdeDeclKind (P.disqualify kn))--    primTypeErrorKinds = foreach (Set.toList PEnv.primTypeErrorKinds) $ \kn ->-      IdeDeclarationAnn emptyAnn (IdeDeclKind (P.disqualify kn))
src/Language/PureScript/Ide/Rebuild.hs view
@@ -53,7 +53,7 @@ rebuildFile file actualFile codegenTargets runOpenBuild = do   (fp, input) <- ideReadFile file   let fp' = fromMaybe fp actualFile-  m <- case CST.parseFromFile fp' input of+  (pwarnings, m) <- case sequence $ CST.parseFromFile fp' input of     Left parseError ->       throwError $ RebuildError $ CST.toMultipleErrors fp' parseError     Right m -> pure m@@ -82,7 +82,7 @@       void populateVolatileState       _ <- updateCacheTimestamp       runOpenBuild (rebuildModuleOpen makeEnv externs m)-      pure (RebuildSuccess warnings)+      pure (RebuildSuccess (CST.toMultipleWarnings fp pwarnings <> warnings))  -- | When adjusting the cache db file after a rebuild we always pick a -- non-sensical timestamp ("1858-11-17T00:00:00Z"), and rely on the@@ -186,7 +186,7 @@   -> m [P.ExternsFile] sortExterns m ex = do   sorted' <- runExceptT-           . P.sortModules P.moduleSignature+           . P.sortModules P.Transitive P.moduleSignature            . (:) m            . map mkShallowModule            . M.elems
src/Language/PureScript/Ide/Reexports.hs view
@@ -104,7 +104,7 @@           Nothing ->             -- If the dataconstructor field inside the TypeRef is Nothing, that             -- means that all data constructors are exported, so we need to look-            -- those up ourselfes+            -- those up ourselves             findDtors tn           Just dtors -> mapMaybe lookupDtor dtors   P.ValueRef _ i ->@@ -115,8 +115,6 @@     findWrapped (anyOf (_IdeDeclTypeOperator . ideTypeOpName) (== name))   P.TypeClassRef _ name ->     findWrapped (anyOf (_IdeDeclTypeClass . ideTCName) (== name))-  P.KindRef _ name ->-    findWrapped (anyOf _IdeDeclKind (== name))   _ ->     Left ref   where
src/Language/PureScript/Ide/SourceFile.hs view
@@ -41,7 +41,7 @@  parseModule' :: FilePath -> Text -> Either FilePath (FilePath, P.Module) parseModule' path file =-  case CST.parseFromFile path file of+  case snd $ CST.parseFromFile path file of     Left _ -> Left path     Right m -> Right (path, m) @@ -96,8 +96,6 @@     [(IdeNamespaced IdeNSValue (P.runIdent ident), ss)]   P.ExternDataDeclaration (ss, _) name _ ->     [(IdeNamespaced IdeNSType (P.runProperName name), ss)]-  P.ExternKindDeclaration (ss, _) name ->-    [(IdeNamespaced IdeNSKind (P.runProperName name), ss)]   _ -> []   where     dtorSpan :: P.DataConstructorDeclaration -> (IdeNamespaced, P.SourceSpan)
src/Language/PureScript/Ide/State.hs view
@@ -261,7 +261,6 @@       annotateValue       annotateDataConstructor       annotateType-      annotateKind       annotateType -- type classes live in the type namespace       annotateModule       d@@ -272,7 +271,6 @@         annotateValue x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSValue x) defs})         annotateDataConstructor x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSValue x) defs})         annotateType x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSType x) defs})-        annotateKind x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSKind x) defs})         annotateModule x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSModule x) defs})  convertDeclaration'@@ -282,10 +280,9 @@   -> (Text -> IdeDeclaration -> IdeDeclarationAnn)   -> (Text -> IdeDeclaration -> IdeDeclarationAnn)   -> (Text -> IdeDeclaration -> IdeDeclarationAnn)-  -> (Text -> IdeDeclaration -> IdeDeclarationAnn)   -> IdeDeclaration   -> IdeDeclarationAnn-convertDeclaration' annotateFunction annotateValue annotateDataConstructor annotateType annotateKind annotateClass annotateModule d =+convertDeclaration' annotateFunction annotateValue annotateDataConstructor annotateType annotateClass annotateModule d =   case d of     IdeDeclValue v ->       annotateFunction (v ^. ideValueIdent) d@@ -301,8 +298,6 @@       annotateValue (operator ^. ideValueOpName . opNameT) d     IdeDeclTypeOperator operator ->       annotateType (operator ^. ideTypeOpName . opNameT) d-    IdeDeclKind i ->-      annotateKind (i ^. properNameT) d     IdeDeclModule mn ->       annotateModule (P.runModuleName mn) d @@ -348,7 +343,6 @@       (annotateValue . P.IdentName . P.Ident)       (annotateValue . P.DctorName . P.ProperName)       (annotateValue . P.TyName . P.ProperName)-      (annotateValue . P.KiName . P.ProperName)       (annotateValue . P.TyClassName . P.ProperName)       (annotateValue . P.ModName . P.moduleNameFromString)       d
src/Language/PureScript/Ide/Types.hs view
@@ -1,13 +1,14 @@ -- | -- Type definitions for psc-ide -{-# language DeriveGeneric, DeriveAnyClass, DeriveFoldable, TemplateHaskell #-}+{-# language DeriveAnyClass, NoGeneralizedNewtypeDeriving, TemplateHaskell #-}  module Language.PureScript.Ide.Types where  import           Protolude hiding (moduleName)  import           Control.Concurrent.STM (TVar)+import           Control.Monad.Fail (fail) import           Data.Aeson (ToJSON, FromJSON, (.=)) import qualified Data.Aeson as Aeson import           Data.IORef (IORef)@@ -15,6 +16,7 @@ import qualified Data.Map.Lazy as M import qualified Language.PureScript as P import qualified Language.PureScript.Errors.JSON as P+import           Language.PureScript.Ide.Filter.Declaration (DeclarationType(..)) import           Lens.Micro.Platform hiding ((.=))  type ModuleIdent = Text@@ -29,7 +31,6 @@   | IdeDeclValueOperator IdeValueOperator   | IdeDeclTypeOperator IdeTypeOperator   | IdeDeclModule P.ModuleName-  | IdeDeclKind (P.ProperName 'P.KindName)   deriving (Show, Eq, Ord, Generic, NFData)  data IdeValue = IdeValue@@ -39,14 +40,14 @@  data IdeType = IdeType  { _ideTypeName :: P.ProperName 'P.TypeName- , _ideTypeKind :: P.SourceKind+ , _ideTypeKind :: P.SourceType  , _ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.SourceType)]  } deriving (Show, Eq, Ord, Generic, NFData)  data IdeTypeSynonym = IdeTypeSynonym   { _ideSynonymName :: P.ProperName 'P.TypeName   , _ideSynonymType :: P.SourceType-  , _ideSynonymKind :: P.SourceKind+  , _ideSynonymKind :: P.SourceType   } deriving (Show, Eq, Ord, Generic, NFData)  data IdeDataConstructor = IdeDataConstructor@@ -57,7 +58,7 @@  data IdeTypeClass = IdeTypeClass   { _ideTCName :: P.ProperName 'P.ClassName-  , _ideTCKind :: P.SourceKind+  , _ideTCKind :: P.SourceType   , _ideTCInstances :: [IdeInstance]   } deriving (Show, Eq, Ord, Generic, NFData) @@ -81,7 +82,7 @@   , _ideTypeOpAlias :: P.Qualified (P.ProperName 'P.TypeName)   , _ideTypeOpPrecedence :: P.Precedence   , _ideTypeOpAssociativity :: P.Associativity-  , _ideTypeOpKind :: Maybe P.SourceKind+  , _ideTypeOpKind :: Maybe P.SourceType   } deriving (Show, Eq, Ord, Generic, NFData)  _IdeDeclValue :: Traversal' IdeDeclaration IdeValue@@ -112,10 +113,6 @@ _IdeDeclTypeOperator f (IdeDeclTypeOperator x) = map IdeDeclTypeOperator (f x) _IdeDeclTypeOperator _ x = pure x -_IdeDeclKind :: Traversal' IdeDeclaration (P.ProperName 'P.KindName)-_IdeDeclKind f (IdeDeclKind x) = map IdeDeclKind (f x)-_IdeDeclKind _ x = pure x- _IdeDeclModule :: Traversal' IdeDeclaration P.ModuleName _IdeDeclModule f (IdeDeclModule x) = map IdeDeclModule (f x) _IdeDeclModule _ x = pure x@@ -227,6 +224,7 @@   , complLocation :: Maybe P.SourceSpan   , complDocumentation :: Maybe Text   , complExportedFrom :: [P.ModuleName]+  , complDeclarationType :: Maybe DeclarationType   } deriving (Show, Eq, Ord)  instance ToJSON Completion where@@ -239,6 +237,7 @@       , "definedAt" .= complLocation       , "documentation" .= complDocumentation       , "exportedFrom" .= map P.runModuleName complExportedFrom+      , "declarationType" .= complDeclarationType       ]  identifierFromDeclarationRef :: P.DeclarationRef -> Text@@ -246,11 +245,20 @@   P.TypeRef _ name _ -> P.runProperName name   P.ValueRef _ ident -> P.runIdent ident   P.TypeClassRef _ name -> P.runProperName name-  P.KindRef _ name -> P.runProperName name   P.ValueOpRef _ op -> P.showOp op   P.TypeOpRef _ op -> P.showOp op   _ -> "" +declarationType :: IdeDeclaration -> DeclarationType+declarationType decl = case decl of+  IdeDeclValue _ -> Value+  IdeDeclType _ -> Type+  IdeDeclTypeSynonym _ -> Synonym+  IdeDeclDataConstructor _ -> DataConstructor+  IdeDeclTypeClass _ -> TypeClass+  IdeDeclValueOperator _ -> ValueOperator+  IdeDeclTypeOperator _ -> TypeOperator+  IdeDeclModule _ -> Module data Success =   CompletionResult [Completion]   | TextResult Text@@ -303,17 +311,15 @@       ] ++ map ("qualifier" .=) (maybeToList qualifier)  -- | Denotes the different namespaces a name in PureScript can reside in.-data IdeNamespace = IdeNSValue | IdeNSType | IdeNSKind | IdeNSModule+data IdeNamespace = IdeNSValue | IdeNSType | IdeNSModule   deriving (Show, Eq, Ord, Generic, NFData)  instance FromJSON IdeNamespace where-  parseJSON (Aeson.String s) = case s of+  parseJSON = Aeson.withText "Namespace" $ \case     "value" -> pure IdeNSValue     "type" -> pure IdeNSType-    "kind" -> pure IdeNSKind     "module" -> pure IdeNSModule-    _       -> mzero-  parseJSON _ = mzero+    s -> fail ("Unknown namespace: " <> show s)  -- | A name tagged with a namespace data IdeNamespaced = IdeNamespaced IdeNamespace Text
src/Language/PureScript/Ide/Usage.hs view
@@ -109,9 +109,6 @@   IdeDeclTypeOperator typeOperator -> case ref of     P.TypeOpRef _ opName -> opName == _ideTypeOpName typeOperator     _ -> False-  IdeDeclKind kind -> case ref of-    P.KindRef _ kindName -> kindName == kind-    _ -> False   IdeDeclModule m -> case ref of     P.ModuleRef _ mn -> m == mn     _ -> False
src/Language/PureScript/Ide/Util.hs view
@@ -33,6 +33,7 @@                                                       encodeUtf8, to)  import           Data.Aeson+import qualified Data.Text                           as T import qualified Data.Text.Lazy                      as TL import           Data.Text.Lazy.Encoding             as TLE import qualified Language.PureScript                 as P@@ -52,7 +53,6 @@   IdeDeclTypeClass tc -> tc ^. ideTCName . properNameT   IdeDeclValueOperator op -> op ^. ideValueOpName & P.runOpName   IdeDeclTypeOperator op -> op ^. ideTypeOpName & P.runOpName-  IdeDeclKind name -> P.runProperName name   IdeDeclModule name -> P.runModuleName name  namespaceForDeclaration :: IdeDeclaration -> IdeNamespace@@ -64,7 +64,6 @@   IdeDeclTypeClass _ -> IdeNSType   IdeDeclValueOperator _ -> IdeNSValue   IdeDeclTypeOperator _ -> IdeNSType-  IdeDeclKind _ -> IdeNSKind   IdeDeclModule _ -> IdeNSModule  discardAnn :: IdeDeclarationAnn -> IdeDeclaration@@ -89,8 +88,8 @@ encodeT :: (ToJSON a) => a -> Text encodeT = TL.toStrict . TLE.decodeUtf8 . encode -decodeT :: (FromJSON a) => Text -> Maybe a-decodeT = decode . TLE.encodeUtf8 . TL.fromStrict+decodeT :: (FromJSON a) => Text -> Either Text a+decodeT = first T.pack . eitherDecode . TLE.encodeUtf8 . TL.fromStrict  properNameT :: Getting r (P.ProperName a) Text properNameT = to P.runProperName
src/Language/PureScript/Interactive.hs view
@@ -30,7 +30,7 @@ import qualified Language.PureScript as P import qualified Language.PureScript.CST as CST import qualified Language.PureScript.Names as N-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  import           Language.PureScript.Interactive.Completion   as Interactive import           Language.PureScript.Interactive.IO           as Interactive@@ -222,8 +222,6 @@     Just $ N.runIdent ident   showRef (P.ModuleRef _ name) =     Just $ "module " <> N.runModuleName name-  showRef (P.KindRef _ pn) =-    Just $ "kind " <> N.runProperName pn   showRef (P.ReExportRef _ _ _) =     Nothing @@ -295,13 +293,13 @@       case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of         Just (_, typ') -> do           let chk = (P.emptyCheckState env') { P.checkCurrentModule = Just mName }-              k   = check (P.kindOf typ') chk+              k   = check (snd <$> P.kindOf typ') chk                check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)               check sew = fst . runWriter . runExceptT . runStateT sew           case k of             Left err        -> printErrors err-            Right (kind, _) -> print' . T.unpack . P.prettyPrintKind $ kind+            Right (kind, _) -> print' . P.prettyPrintType 1024 $ kind         Nothing -> print' "Could not find kind"  -- | Browse a module and displays its signature
src/Language/PureScript/Interactive/Module.hs view
@@ -27,7 +27,7 @@   pwd <- getCurrentDirectory   content <- readUTF8FileT filename   return $-    either (Left . P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd}) (Right . map snd) $+    either (Left . P.prettyPrintMultipleErrors P.defaultPPEOptions {P.ppeRelativeDirectory = pwd}) (Right . map (snd . snd)) $       CST.parseFromFiles id [(filename, content)]  -- | Load all modules.@@ -35,7 +35,7 @@ loadAllModules files = do   pwd <- getCurrentDirectory   filesAndContent <- readUTF8FilesT files-  return $ CST.parseFromFiles (makeRelative pwd) filesAndContent+  return $ fmap (fmap snd) <$> CST.parseFromFiles (makeRelative pwd) filesAndContent  -- | -- Makes a volatile module to execute the current expression.
src/Language/PureScript/Interactive/Parser.hs view
@@ -9,7 +9,7 @@ import           Prelude.Compat hiding (lex)  import           Control.Monad (join, unless)-import           Data.Bifunctor (first)+import           Data.Bifunctor (bimap) import           Data.Char (isSpace) import           Data.List (intercalate) import qualified Data.List.NonEmpty as NE@@ -26,7 +26,7 @@ -- parseDotFile :: FilePath -> String -> Either String [Command] parseDotFile filePath =-  first (CST.prettyPrintError . NE.head)+  bimap (CST.prettyPrintError . NE.head) snd     . CST.runTokenParser (parseMany parser <* CSTM.token CST.TokEof)     . CST.lexTopLevel     . T.pack@@ -65,7 +65,7 @@  parseRest :: CST.Parser a -> String -> Either String a parseRest p =-   first (CST.prettyPrintError . NE.head)+   bimap (CST.prettyPrintError . NE.head) snd     . CST.runTokenParser (p <* CSTM.token CST.TokEof)     . CST.lexTopLevel     . T.pack@@ -146,7 +146,6 @@ acceptable P.ExternDataDeclaration{} = True acceptable P.TypeClassDeclaration{} = True acceptable P.TypeInstanceDeclaration{} = True-acceptable P.ExternKindDeclaration{} = True acceptable P.TypeDeclaration{} = True acceptable P.ValueDeclaration{} = True acceptable _ = False
src/Language/PureScript/Interactive/Printer.hs view
@@ -25,6 +25,8 @@     let moduleNamesIdent = byModuleName names         moduleTypeClasses = byModuleName typeClasses         moduleTypes = byModuleName types++        byModuleName :: M.Map (P.Qualified a) b -> [P.Qualified a]         byModuleName = filter ((== Just moduleName) . P.getQual) . M.keys    in@@ -61,7 +63,7 @@                     if null typeClassSuperclasses                     then Box.text ""                     else Box.text "("-                         Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint _ (P.Qualified _ pn) lt _) -> textT (P.runProperName pn) Box.<+> Box.hcat Box.left (map (P.typeAtomAsBox maxBound) lt)) typeClassSuperclasses)+                         Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint _ (P.Qualified _ pn) _ lt _) -> textT (P.runProperName pn) Box.<+> Box.hcat Box.left (map (P.typeAtomAsBox maxBound) lt)) typeClassSuperclasses)                          Box.<> Box.text ") <= "                 className =                     textT (P.runProperName name)@@ -79,16 +81,16 @@           findType-          :: M.Map (P.Qualified (P.ProperName 'P.TypeName)) (P.SourceKind, P.TypeKind)+          :: M.Map (P.Qualified (P.ProperName 'P.TypeName)) (P.SourceType, P.TypeKind)           -> P.Qualified (P.ProperName 'P.TypeName)-          -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.SourceKind, P.TypeKind))+          -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.SourceType, P.TypeKind))         findType envTypes name = (name, M.lookup name envTypes)          showType           :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) P.TypeClassData           -> M.Map (P.Qualified (P.ProperName 'P.ConstructorName)) (P.DataDeclType, P.ProperName 'P.TypeName, P.SourceType, [P.Ident])-          -> M.Map (P.Qualified (P.ProperName 'P.TypeName)) ([(Text, Maybe P.SourceKind)], P.SourceType)-          -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.SourceKind, P.TypeKind))+          -> M.Map (P.Qualified (P.ProperName 'P.TypeName)) ([(Text, Maybe P.SourceType)], P.SourceType)+          -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.SourceType, P.TypeKind))           -> Maybe Box.Box         showType typeClassesEnv dataConstructorsEnv typeSynonymsEnv (n@(P.Qualified modul name), typ) =           case (typ, M.lookup n typeSynonymsEnv) of@@ -101,7 +103,7 @@                     textT ("type " <> P.runProperName name <> foldMap ((" " <>) . fst) typevars)                     Box.// Box.moveRight 2 (Box.text "=" Box.<+> P.typeAsBox maxBound dtType) -            (Just (_, P.DataType typevars pt), _) ->+            (Just (_, P.DataType _ typevars pt), _) ->               let prefix =                     case pt of                       [(dtProperName,_)] ->@@ -111,7 +113,7 @@                       _ -> "data"                in-                Just $ textT (prefix <> " " <> P.runProperName name <> foldMap ((" " <>) . fst) typevars) Box.// printCons pt+                Just $ textT (prefix <> " " <> P.runProperName name <> foldMap ((" " <>) . (\(v, _, _) -> v)) typevars) Box.// printCons pt              _ ->               Nothing
src/Language/PureScript/Interactive/Types.hs view
@@ -37,6 +37,7 @@ import           Language.PureScript.Sugar.Names.Env (nullImports, primExports) import           Control.Monad (foldM) import           Control.Monad.Trans.Except (runExceptT)+import           Control.Monad.Trans.State (execStateT) import           Control.Monad.Writer.Strict (runWriterT)  @@ -119,16 +120,16 @@ -- ensure that completions remain accurate. updateImportExports :: PSCiState -> PSCiState updateImportExports st@(PSCiState modules lets externs iprint _ _) =-  case createEnv (map snd externs) >>= flip desugarModule [temporaryModule] of+  case createEnv (map snd externs) >>= flip desugarModule temporaryModule of     Left _          -> st -- TODO: can this fail and what should we do?-    Right (env, _)  ->+    Right env  ->       case M.lookup temporaryName env of         Just (_, is, es)  -> PSCiState modules lets externs iprint is es         _                 -> st -- impossible   where -  desugarModule :: P.Env -> [P.Module] -> Either P.MultipleErrors (P.Env, [P.Module])-  desugarModule e = runExceptT =<< fmap fst . runWriterT . P.desugarImportsWithEnv e+  desugarModule :: P.Env -> P.Module -> Either P.MultipleErrors P.Env+  desugarModule e = runExceptT =<< fmap (fst . fst) . runWriterT . flip execStateT (e, mempty) . P.desugarImports    createEnv :: [P.ExternsFile] -> Either P.MultipleErrors P.Env   createEnv = runExceptT =<< fmap fst . runWriterT . foldM P.externsEnv P.primEnv
− src/Language/PureScript/Kinds.hs 
@@ -1,185 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Language.PureScript.Kinds where--import Prelude.Compat--import GHC.Generics (Generic)-import Codec.Serialise (Serialise)-import Control.Applicative ((<|>))-import Control.DeepSeq (NFData)-import Data.Text (Text)-import Data.Aeson (Value, toJSON, (.=), (.:))-import Data.Aeson.Types (Parser)-import qualified Data.Aeson as A--import Language.PureScript.AST.SourcePos-import Language.PureScript.Names--import Lens.Micro.Platform (Lens', (^.), set)--type SourceKind = Kind SourceAnn---- | The data type of kinds-data Kind a-  -- | Unification variable of type Kind-  = KUnknown a Int-  -- | Kinds for labelled, unordered rows without duplicates-  | Row a (Kind a)-  -- | Function kinds-  | FunKind a (Kind a) (Kind a)-  -- | A named kind-  | NamedKind a (Qualified (ProperName 'KindName))-  deriving (Show, Generic, Functor, Foldable, Traversable)--instance NFData a => NFData (Kind a)-instance Serialise a => Serialise (Kind a)--srcKUnknown :: Int -> SourceKind-srcKUnknown = KUnknown NullSourceAnn--srcRow :: SourceKind -> SourceKind-srcRow = Row NullSourceAnn--srcFunKind :: SourceKind -> SourceKind -> SourceKind-srcFunKind = FunKind NullSourceAnn--srcNamedKind :: Qualified (ProperName 'KindName) -> SourceKind-srcNamedKind = NamedKind NullSourceAnn--kindToJSON :: forall a. (a -> Value) -> Kind a -> Value-kindToJSON annToJSON kind =-  case kind of-    KUnknown a i ->-      variant "KUnknown" a i-    Row a k ->-      variant "Row" a (go k)-    FunKind a k1 k2 ->-      variant "FunKind" a (go k1, go k2)-    NamedKind a n ->-      variant "NamedKind" a n-  where-  go :: Kind a -> Value-  go = kindToJSON annToJSON--  variant :: A.ToJSON b => Text -> a -> b -> A.Value-  variant tag ann contents =-    A.object-      [ "tag"        .= tag-      , "annotation" .= annToJSON ann-      , "contents"   .= contents-      ]--instance A.ToJSON a => A.ToJSON (Kind a) where-  toJSON = kindToJSON toJSON--kindFromJSON :: forall a. Parser a -> (Value -> Parser a) -> Value -> Parser (Kind a)-kindFromJSON defaultAnn annFromJSON = A.withObject "Kind" $ \o -> do-  tag <- o .: "tag"-  a   <- (o .: "annotation" >>= annFromJSON) <|> defaultAnn-  let-    contents :: A.FromJSON b => Parser b-    contents = o .: "contents"-  case tag of-    "KUnknown" ->-      KUnknown a <$> contents-    "Row" ->-      Row a <$> (go =<< contents)-    "FunKind" -> do-      (b, c) <- contents-      FunKind a <$> go b <*> go c-    "NamedKind" ->-      NamedKind a <$> contents-    other ->-      fail $ "Unrecognised tag: " ++ other-  where-  go :: Value -> Parser (Kind a)-  go = kindFromJSON defaultAnn annFromJSON---- These overlapping instances exist to preserve compatibility for common--- instances which have a sensible default for missing annotations.-instance {-# OVERLAPPING #-} A.FromJSON (Kind SourceAnn) where-  parseJSON = kindFromJSON (pure NullSourceAnn) A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON (Kind ()) where-  parseJSON = kindFromJSON (pure ()) A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON a => A.FromJSON (Kind a) where-  parseJSON = kindFromJSON (fail "Invalid annotation") A.parseJSON--everywhereOnKinds :: (Kind a -> Kind a) -> Kind a -> Kind a-everywhereOnKinds f = go-  where-  go (Row ann k1) = f (Row ann (go k1))-  go (FunKind ann k1 k2) = f (FunKind ann (go k1) (go k2))-  go other = f other--everywhereOnKindsM :: Monad m => (Kind a -> m (Kind a)) -> Kind a -> m (Kind a)-everywhereOnKindsM f = go-  where-  go (Row ann k1) = (Row ann <$> go k1) >>= f-  go (FunKind ann k1 k2) = (FunKind ann <$> go k1 <*> go k2) >>= f-  go other = f other--everythingOnKinds :: (r -> r -> r) -> (Kind a -> r) -> Kind a -> r-everythingOnKinds (<>.) f = go-  where-  go k@(Row _ k1) = f k <>. go k1-  go k@(FunKind _ k1 k2) = f k <>. go k1 <>. go k2-  go other = f other--annForKind :: Lens' (Kind a) a-annForKind k (KUnknown a b) = (\z -> KUnknown z b) <$> k a-annForKind k (Row a b) = (\z -> Row z b) <$> k a-annForKind k (FunKind a b c) = (\z -> FunKind z b c) <$> k a-annForKind k (NamedKind a b) = (\z -> NamedKind z b) <$> k a--getAnnForKind :: Kind a -> a-getAnnForKind = (^. annForKind)--setAnnForKind :: a -> Kind a -> Kind a-setAnnForKind = set annForKind--instance Eq (Kind a) where-  (==) = eqKind--instance Ord (Kind a) where-  compare = compareKind--eqKind :: Kind a -> Kind b -> Bool-eqKind (KUnknown _ a) (KUnknown _ a') = a == a'-eqKind (Row _ a) (Row _ a') = eqKind a a'-eqKind (FunKind _ a b) (FunKind _ a' b') = eqKind a a' && eqKind b b'-eqKind (NamedKind _ a) (NamedKind _ a') = a == a'-eqKind _ _ = False--eqMaybeKind :: Maybe (Kind a) -> Maybe (Kind b) -> Bool-eqMaybeKind Nothing (Just _) = False-eqMaybeKind (Just _) Nothing = False-eqMaybeKind Nothing Nothing = True-eqMaybeKind (Just a) (Just b) = eqKind a b--compareKind :: Kind a -> Kind b -> Ordering-compareKind (KUnknown _ a) (KUnknown _ a') = compare a a'-compareKind (KUnknown {}) _ = LT--compareKind (Row _ a) (Row _ a') = compareKind a a'-compareKind (Row {}) _ = LT-compareKind _ (Row {}) = GT--compareKind (FunKind _ a b) (FunKind _ a' b') = compareKind a b <> compareKind a' b'-compareKind (FunKind {}) _ = LT-compareKind _ (FunKind {}) = GT--compareKind (NamedKind _ a) (NamedKind _ a') = compare a a'-compareKind (NamedKind {}) _ = GT--compareMaybeKind :: Maybe (Kind a) -> Maybe (Kind b) -> Ordering-compareMaybeKind Nothing Nothing = EQ-compareMaybeKind Nothing (Just _) = LT-compareMaybeKind (Just _) Nothing = GT-compareMaybeKind (Just a) (Just b) = compareKind a b
− src/Language/PureScript/Label.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveGeneric #-}--module Language.PureScript.Label (Label(..)) where--import Prelude.Compat hiding (lex)-import GHC.Generics (Generic)-import Codec.Serialise (Serialise)-import Control.DeepSeq (NFData)-import Data.Monoid ()-import Data.String (IsString(..))-import qualified Data.Aeson as A--import Language.PureScript.PSString (PSString)---- |--- Labels are used as record keys and row entry names. Labels newtype PSString--- because records are indexable by PureScript strings at runtime.----newtype Label = Label { runLabel :: PSString }-  deriving (Show, Eq, Ord, IsString, Semigroup, Monoid, A.ToJSON, A.FromJSON, Generic)--instance NFData Label-instance Serialise Label
src/Language/PureScript/Linter.hs view
@@ -96,12 +96,15 @@       -- Recursively walk the type and prune used variables from `unused`       go :: S.Set Text -> SourceType -> (S.Set Text, MultipleErrors)       go unused (TypeVar _ v) = (S.delete v unused, mempty)-      go unused (ForAll _ tv _ t1 _) =-        let (nowUnused, errors) = go (S.insert tv unused) t1+      go unused (ForAll _ tv mbK t1 _) =+        let (nowUnused, errors)+              | Just k <- mbK = go unused k `combine` go (S.insert tv unused) t1+              | otherwise = go (S.insert tv unused) t1             restoredUnused = if S.member tv unused then S.insert tv nowUnused else nowUnused             combinedErrors = if S.member tv nowUnused then errors <> errorMessage' ss (UnusedTypeVar tv) else errors         in (restoredUnused, combinedErrors)       go unused (TypeApp _ f x) = go unused f `combine` go unused x+      go unused (KindApp _ f x) = go unused f `combine` go unused x       go unused (ConstrainedType _ c t1) = foldl combine (unused, mempty) $ map (go unused) (constraintArgs c <> [t1])       go unused (RCons _ _ t1 rest) = go unused t1 `combine` go unused rest       go unused (KindedType _ t1 _) = go unused t1
src/Language/PureScript/Linter/Exhaustive.hs view
@@ -28,14 +28,13 @@ import Language.PureScript.AST.Declarations import Language.PureScript.AST.Literals import Language.PureScript.Crash-import Language.PureScript.Environment+import Language.PureScript.Environment hiding (tyVar) import Language.PureScript.Errors-import Language.PureScript.Kinds import Language.PureScript.Names as P import Language.PureScript.Pretty.Values (prettyPrintBinderAtom) import Language.PureScript.Traversals import Language.PureScript.Types as P-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  -- | There are two modes of failure for the redundancy check: --@@ -67,11 +66,11 @@ getConstructors env defmn n = extractConstructors lnte   where -  extractConstructors :: Maybe (SourceKind, TypeKind) -> [(ProperName 'ConstructorName, [SourceType])]-  extractConstructors (Just (_, DataType _ pt)) = pt+  extractConstructors :: Maybe (SourceType, TypeKind) -> [(ProperName 'ConstructorName, [SourceType])]+  extractConstructors (Just (_, DataType _ _ pt)) = pt   extractConstructors _ = internalError "Data name not in the scope of the current environment in extractConstructors" -  lnte :: Maybe (SourceKind, TypeKind)+  lnte :: Maybe (SourceType, TypeKind)   lnte = M.lookup qpn (types env)    qpn :: Qualified (ProperName 'TypeName)@@ -308,7 +307,7 @@         srcForAll tyVar           Nothing           ( srcConstrainedType-              (srcConstraint C.Partial [] (Just constraintData))+              (srcConstraint C.Partial [] [] (Just constraintData))               $ srcTypeApp (srcTypeApp tyFunction (srcTypeVar tyVar)) (srcTypeVar tyVar)           )           Nothing
src/Language/PureScript/Linter/Imports.hs view
@@ -12,7 +12,7 @@  import Data.Function (on) import Data.Foldable (for_)-import Data.List (find, intersect, groupBy, sortBy, (\\))+import Data.List (find, intersect, groupBy, sort, sortBy, (\\)) import Data.Maybe (mapMaybe) import Data.Monoid (Sum(..)) import Data.Traversable (forM)@@ -27,7 +27,7 @@ import Language.PureScript.Sugar.Names.Common (warnDuplicateRefs) import Language.PureScript.Sugar.Names.Env import Language.PureScript.Sugar.Names.Imports-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C  -- | -- Map of module name to list of imported names from that module which have@@ -178,7 +178,6 @@       ++ extractByQual mne (importedDataConstructors scope) DctorName       ++ extractByQual mne (importedValues scope) IdentName       ++ extractByQual mne (importedValueOps scope) ValOpName-      ++ extractByQual mne (importedKinds scope) KiName     where     go :: (ModuleName, Qualified Name) -> UsedImports -> UsedImports     go (q, name) = M.alter (Just . maybe [name] (name :)) q@@ -203,7 +202,7 @@   -- Replace explicit type refs with data constructor lists from listing the--- used constructors explicity `T(X, Y, [...])` to `T(..)` for suggestion+-- used constructors explicitly `T(X, Y, [...])` to `T(..)` for suggestion -- message. -- Done everywhere when suggesting a completely new explicit imports list, otherwise -- maintain the existing form.@@ -329,14 +328,13 @@     valueOpRefs = ValueOpRef ss <$> mapMaybe (getValOpName <=< disqualifyFor qn) names     typeOpRefs = TypeOpRef ss <$> mapMaybe (getTypeOpName <=< disqualifyFor qn) names     types = mapMaybe (getTypeName <=< disqualifyFor qn) names-    kindRefs = KindRef ss <$> mapMaybe (getKindName <=< disqualifyFor qn) names     dctors = mapMaybe (getDctorName <=< disqualifyFor qn) names     typesWithDctors = reconstructTypeRefs dctors     typesWithoutDctors = filter (`M.notMember` typesWithDctors) types     typesRefs       = map (flip (TypeRef ss) (Just [])) typesWithoutDctors       ++ map (\(ty, ds) -> TypeRef ss ty (Just ds)) (M.toList typesWithDctors)-  in sortBy compDecRef $ classRefs ++ typeOpRefs ++ typesRefs ++ kindRefs ++ valueRefs ++ valueOpRefs+  in sort $ classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs    where @@ -374,7 +372,6 @@ runDeclRef (TypeRef _ pn _) = Just $ TyName pn runDeclRef (TypeOpRef _ op) = Just $ TyOpName op runDeclRef (TypeClassRef _ pn) = Just $ TyClassName pn-runDeclRef (KindRef _ pn) = Just $ KiName pn runDeclRef _ = Nothing  checkDuplicateImports
src/Language/PureScript/Make.hs view
@@ -16,10 +16,11 @@ import           Control.Monad.IO.Class import           Control.Monad.Supply import           Control.Monad.Trans.Control (MonadBaseControl(..))-import           Control.Monad.Writer.Class (MonadWriter(..))+import           Control.Monad.Trans.State (runStateT)+import           Control.Monad.Writer.Class (MonadWriter(..), censor) import           Control.Monad.Writer.Strict (runWriterT) import           Data.Function (on)-import           Data.Foldable (for_)+import           Data.Foldable (fold, for_) import           Data.List (foldl', sortBy) import qualified Data.List.NonEmpty as NEL import           Data.Maybe (fromMaybe)@@ -75,10 +76,18 @@   let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs       withPrim = importPrim m   lint withPrim+   ((Module ss coms _ elaborated exps, env'), nextVar) <- runSupplyT 0 $ do-    desugar exEnv externs [withPrim] >>= \case-      [desugared] -> runCheck' (emptyCheckState env) $ typeCheckModule desugared-      _ -> internalError "desugar did not return a singleton"+    (desugared, (exEnv', usedImports)) <- runStateT (desugar externs withPrim) (exEnv, mempty)+    let modulesExports = (\(_, _, exports) -> exports) <$> exEnv'+    (checked, CheckState{..}) <- runStateT (typeCheckModule modulesExports desugared) $ emptyCheckState env+    let usedImports' = foldl' (flip $ \(fromModuleName, newtypeCtorName) ->+          M.alter (Just . (fmap DctorName newtypeCtorName :) . fold) fromModuleName) usedImports checkConstructorImportsForCoercible+    -- Imports cannot be linted before type checking because we need to+    -- known which newtype constructors are used to solve Coercible+    -- constraints in order to not report them as unused.+    censor (addHint (ErrorInModule moduleName)) $ lintImports checked exEnv' usedImports'+    return (checked, checkEnv)    -- desugar case declarations *after* type- and exhaustiveness checking   -- since pattern guards introduces cases which the exhaustiveness checker@@ -122,7 +131,7 @@   checkModuleNames   cacheDb <- readCacheDb -  (sorted, graph) <- sortModules (moduleSignature . CST.resPartial) ms+  (sorted, graph) <- sortModules Transitive (moduleSignature . CST.resPartial) ms    (buildPlan, newCacheDb) <- BuildPlan.construct ma cacheDb (sorted, graph) @@ -132,7 +141,8 @@     let deps = fromMaybe (internalError "make: module not found in dependency graph.") (lookup moduleName graph)     buildModule buildPlan moduleName       (spanName . getModuleSourceSpan . CST.resPartial $ m)-      (importPrim <$> CST.resFull m)+      (fst $ CST.resFull m)+      (fmap importPrim . snd $ CST.resFull m)       (deps `inOrderOf` map (getModuleName . CST.resPartial) sorted)    -- Wait for all threads to complete, and collect results (and errors).@@ -197,9 +207,11 @@   inOrderOf :: (Ord a) => [a] -> [a] -> [a]   inOrderOf xs ys = let s = S.fromList xs in filter (`S.member` s) ys -  buildModule :: BuildPlan -> ModuleName -> FilePath -> Either (NEL.NonEmpty CST.ParserError) Module -> [ModuleName] -> m ()-  buildModule buildPlan moduleName fp mres deps = do+  buildModule :: BuildPlan -> ModuleName -> FilePath -> [CST.ParserWarning] -> Either (NEL.NonEmpty CST.ParserError) Module -> [ModuleName] -> m ()+  buildModule buildPlan moduleName fp pwarnings mres deps = do     result <- flip catchError (return . BuildJobFailed) $ do+      let pwarnings' = CST.toMultipleWarnings fp pwarnings+      tell pwarnings'       m <- CST.unwrapParserError fp mres       -- We need to wait for dependencies to be built, before checking if the current       -- module should be rebuilt, so the first thing to do is to wait on the@@ -219,7 +231,7 @@             foldM go env deps           env <- C.readMVar (bpEnv buildPlan)           (exts, warnings) <- listen $ rebuildModule' ma env externs m-          return $ BuildJobSucceeded warnings exts+          return $ BuildJobSucceeded (pwarnings' <> warnings) exts         Nothing -> return BuildJobSkipped      BuildPlan.markComplete buildPlan moduleName result
src/Language/PureScript/Make/Actions.hs view
@@ -26,6 +26,7 @@ import           Data.Maybe (fromMaybe, maybeToList) import qualified Data.Set as S import qualified Data.Text as T+import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as TE import           Data.Time.Clock (UTCTime) import           Data.Version (showVersion)@@ -54,6 +55,7 @@ import           SourceMap.Types import           System.Directory (getCurrentDirectory) import           System.FilePath ((</>), makeRelative, splitPath, normalise)+import           System.IO (stderr)  -- | Determines when to rebuild a module data RebuildPolicy@@ -70,8 +72,8 @@   deriving (Show, Eq, Ord)  -- | Render a progress message-renderProgressMessage :: ProgressMessage -> String-renderProgressMessage (CompilingModule mn) = "Compiling " ++ T.unpack (runModuleName mn)+renderProgressMessage :: ProgressMessage -> T.Text+renderProgressMessage (CompilingModule mn) = T.append "Compiling " (runModuleName mn)  -- | Actions that require implementations when running in "make" mode. --@@ -269,7 +271,7 @@   requiresForeign = not . null . CF.moduleForeign    progress :: ProgressMessage -> Make ()-  progress = liftIO . putStrLn . renderProgressMessage+  progress = liftIO . TIO.hPutStr stderr . (<> "\n") . renderProgressMessage    readCacheDb :: Make CacheDb   readCacheDb = readCacheDb' outputDir@@ -285,6 +287,11 @@   js <- either (errorParsingModule . Bundle.UnableToParseModule) pure $ JS.parse jsStr path    foreignIdentsStrs <- either errorParsingModule pure $ getExps js++  let deprecatedFFI = filter (elem '\'') foreignIdentsStrs+  unless (null deprecatedFFI) $+    warningDeprecatedForeignPrimes deprecatedFFI+   foreignIdents <- either                      errorInvalidForeignIdentifiers                      (pure . S.fromList)@@ -315,6 +322,10 @@   errorInvalidForeignIdentifiers =     throwError . mconcat . map (errorMessage . InvalidFFIIdentifier mname . T.pack) +  warningDeprecatedForeignPrimes :: [String] -> Make ()+  warningDeprecatedForeignPrimes =+    tell . mconcat . map (errorMessage' modSS . DeprecatedFFIPrime mname . T.pack)+   parseIdents :: [String] -> Either [String] [Ident]   parseIdents strs =     case partitionEithers (map parseIdent strs) of@@ -327,7 +338,7 @@   -- identifier should be enough.   parseIdent :: String -> Either String Ident   parseIdent str =-    bimap (const str) (Ident . CST.getIdent . CST.nameValue)+    bimap (const str) (Ident . CST.getIdent . CST.nameValue . snd)       . CST.runTokenParser CST.parseIdent       . CST.lex       $ T.pack str
src/Language/PureScript/Make/Monad.hs view
@@ -40,7 +40,6 @@ import           Data.Text (Text) import qualified Data.Text as Text import           Data.Time.Clock (UTCTime)-import           Language.PureScript.AST import           Language.PureScript.Errors import           Language.PureScript.Externs (ExternsFile, externsIsCurrentVersion) import           Language.PureScript.Make.Cache (ContentHash, hash)
src/Language/PureScript/ModuleDependencies.hs view
@@ -1,6 +1,7 @@ -- | Provides the ability to sort modules based on module dependencies module Language.PureScript.ModuleDependencies-  ( sortModules+  ( DependencyDepth(..)+  , sortModules   , ModuleGraph   , ModuleSignature(..)   , moduleSignature@@ -8,10 +9,11 @@  import           Protolude hiding (head) +import           Data.Array ((!)) import           Data.Graph import qualified Data.Set as S import           Language.PureScript.AST-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C import           Language.PureScript.Crash import           Language.PureScript.Errors hiding (nonEmpty) import           Language.PureScript.Names@@ -26,16 +28,19 @@   , sigImports :: [(ModuleName, SourceSpan)]   } +data DependencyDepth = Direct | Transitive+ -- | Sort a collection of modules based on module dependencies. -- -- Reports an error if the module graph contains a cycle. sortModules   :: forall m a    . MonadError MultipleErrors m-  => (a -> ModuleSignature)+  => DependencyDepth+  -> (a -> ModuleSignature)   -> [a]   -> m ([a], ModuleGraph)-sortModules toSig ms = do+sortModules dependencyDepth toSig ms = do     let       ms' = (\m -> (m, toSig m)) <$> ms       mns = S.fromList $ map (sigModuleName . snd) ms'@@ -44,7 +49,9 @@     let (graph, fromVertex, toVertex) = graphFromEdges verts         moduleGraph = do (_, mn, _) <- verts                          let v       = fromMaybe (internalError "sortModules: vertex not found") (toVertex mn)-                             deps    = reachable graph v+                             deps    = case dependencyDepth of+                                         Direct -> graph ! v+                                         Transitive -> reachable graph v                              toKey i = case fromVertex i of (_, key, _) -> key                          return (mn, filter (/= mn) (map toKey deps))     return (fst <$> ms'', moduleGraph)
− src/Language/PureScript/Names.hs 
@@ -1,262 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Data types for names----module Language.PureScript.Names where--import Prelude.Compat--import Codec.Serialise (Serialise)-import Control.Monad.Supply.Class-import Control.DeepSeq (NFData)-import Data.Functor.Contravariant (contramap)-import qualified Data.Vector as V--import GHC.Generics (Generic)-import Data.Aeson-import Data.Aeson.TH-import Data.Text (Text)-import qualified Data.Text as T---- | A sum of the possible name types, useful for error and lint messages.-data Name-  = IdentName Ident-  | ValOpName (OpName 'ValueOpName)-  | TyName (ProperName 'TypeName)-  | TyOpName (OpName 'TypeOpName)-  | DctorName (ProperName 'ConstructorName)-  | TyClassName (ProperName 'ClassName)-  | ModName ModuleName-  | KiName (ProperName 'KindName)-  deriving (Eq, Ord, Show, Generic)--instance NFData Name-instance Serialise Name--getIdentName :: Name -> Maybe Ident-getIdentName (IdentName name) = Just name-getIdentName _ = Nothing--getValOpName :: Name -> Maybe (OpName 'ValueOpName)-getValOpName (ValOpName name) = Just name-getValOpName _ = Nothing--getTypeName :: Name -> Maybe (ProperName 'TypeName)-getTypeName (TyName name) = Just name-getTypeName _ = Nothing--getKindName :: Name -> Maybe (ProperName 'KindName)-getKindName (KiName name) = Just name-getKindName _ = Nothing--getTypeOpName :: Name -> Maybe (OpName 'TypeOpName)-getTypeOpName (TyOpName name) = Just name-getTypeOpName _ = Nothing--getDctorName :: Name -> Maybe (ProperName 'ConstructorName)-getDctorName (DctorName name) = Just name-getDctorName _ = Nothing--getClassName :: Name -> Maybe (ProperName 'ClassName)-getClassName (TyClassName name) = Just name-getClassName _ = Nothing--getModName :: Name -> Maybe ModuleName-getModName (ModName name) = Just name-getModName _ = Nothing---- |--- Names for value identifiers----data Ident-  -- |-  -- An alphanumeric identifier-  ---  = Ident Text-  -- |-  -- A generated name for an identifier-  ---  | GenIdent (Maybe Text) Integer-  -- |-  -- A generated name used only for type-checking-  ---  | UnusedIdent-  deriving (Show, Eq, Ord, Generic)--instance NFData Ident-instance Serialise Ident--runIdent :: Ident -> Text-runIdent (Ident i) = i-runIdent (GenIdent Nothing n) = "$" <> T.pack (show n)-runIdent (GenIdent (Just name) n) = "$" <> name <> T.pack (show n)-runIdent UnusedIdent = "$__unused"--showIdent :: Ident -> Text-showIdent = runIdent--freshIdent :: MonadSupply m => Text -> m Ident-freshIdent name = GenIdent (Just name) <$> fresh--freshIdent' :: MonadSupply m => m Ident-freshIdent' = GenIdent Nothing <$> fresh---- |--- Operator alias names.----newtype OpName (a :: OpNameType) = OpName { runOpName :: Text }-  deriving (Show, Eq, Ord, Generic)--instance NFData (OpName a)-instance Serialise (OpName a)--instance ToJSON (OpName a) where-  toJSON = toJSON . runOpName--instance FromJSON (OpName a) where-  parseJSON = fmap OpName . parseJSON--showOp :: OpName a -> Text-showOp op = "(" <> runOpName op <> ")"---- |--- The closed set of operator alias types.----data OpNameType = ValueOpName | TypeOpName | AnyOpName--eraseOpName :: OpName a -> OpName 'AnyOpName-eraseOpName = OpName . runOpName---- |--- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.----newtype ProperName (a :: ProperNameType) = ProperName { runProperName :: Text }-  deriving (Show, Eq, Ord, Generic)--instance NFData (ProperName a)-instance Serialise (ProperName a)--instance ToJSON (ProperName a) where-  toJSON = toJSON . runProperName--instance FromJSON (ProperName a) where-  parseJSON = fmap ProperName . parseJSON---- |--- The closed set of proper name types.----data ProperNameType-  = TypeName-  | ConstructorName-  | ClassName-  | KindName-  | Namespace---- |--- Coerces a ProperName from one ProperNameType to another. This should be used--- with care, and is primarily used to convert ClassNames into TypeNames after--- classes have been desugared.----coerceProperName :: ProperName a -> ProperName b-coerceProperName = ProperName . runProperName---- |--- Module names----newtype ModuleName = ModuleName Text-  deriving (Show, Eq, Ord, Generic)-  deriving newtype Serialise--instance NFData ModuleName--runModuleName :: ModuleName -> Text-runModuleName (ModuleName name) = name--moduleNameFromString :: Text -> ModuleName-moduleNameFromString = ModuleName--isBuiltinModuleName :: ModuleName -> Bool-isBuiltinModuleName (ModuleName mn) = mn == "Prim" || T.isPrefixOf "Prim." mn---- |--- A qualified name, i.e. a name with an optional module name----data Qualified a = Qualified (Maybe ModuleName) a-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)--instance NFData a => NFData (Qualified a)-instance Serialise a => Serialise (Qualified a)--showQualified :: (a -> Text) -> Qualified a -> Text-showQualified f (Qualified Nothing a) = f a-showQualified f (Qualified (Just name) a) = runModuleName name <> "." <> f a--getQual :: Qualified a -> Maybe ModuleName-getQual (Qualified mn _) = mn---- |--- Provide a default module name, if a name is unqualified----qualify :: ModuleName -> Qualified a -> (ModuleName, a)-qualify m (Qualified Nothing a) = (m, a)-qualify _ (Qualified (Just m) a) = (m, a)---- |--- Makes a qualified value from a name and module name.----mkQualified :: a -> ModuleName -> Qualified a-mkQualified name mn = Qualified (Just mn) name---- | Remove the module name from a qualified name-disqualify :: Qualified a -> a-disqualify (Qualified _ a) = a---- |--- Remove the qualification from a value when it is qualified with a particular--- module name.----disqualifyFor :: Maybe ModuleName -> Qualified a -> Maybe a-disqualifyFor mn (Qualified mn' a) | mn == mn' = Just a-disqualifyFor _ _ = Nothing---- |--- Checks whether a qualified value is actually qualified with a module reference----isQualified :: Qualified a -> Bool-isQualified (Qualified Nothing _) = False-isQualified _ = True---- |--- Checks whether a qualified value is not actually qualified with a module reference----isUnqualified :: Qualified a -> Bool-isUnqualified = not . isQualified---- |--- Checks whether a qualified value is qualified with a particular module----isQualifiedWith :: ModuleName -> Qualified a -> Bool-isQualifiedWith mn (Qualified (Just mn') _) = mn == mn'-isQualifiedWith _ _ = False--$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Qualified)-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Ident)--instance ToJSON ModuleName where-  toJSON (ModuleName name) = toJSON (T.splitOn "." name)--instance FromJSON ModuleName where-  parseJSON = withArray "ModuleName" $ \names -> do-    names' <- traverse parseJSON names-    pure (ModuleName (T.intercalate "." (V.toList names')))--instance ToJSONKey ModuleName where-  toJSONKey = contramap runModuleName toJSONKey--instance FromJSONKey ModuleName where-  fromJSONKey = fmap moduleNameFromString fromJSONKey
− src/Language/PureScript/PSString.hs 
@@ -1,242 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric #-}--module Language.PureScript.PSString-  ( PSString-  , toUTF16CodeUnits-  , decodeString-  , decodeStringEither-  , decodeStringWithReplacement-  , prettyPrintString-  , prettyPrintStringJS-  , mkString-  ) where--import Prelude.Compat-import GHC.Generics (Generic)-import Codec.Serialise (Serialise)-import Control.DeepSeq (NFData)-import Control.Exception (try, evaluate)-import Control.Applicative ((<|>))-import qualified Data.Char as Char-import Data.Bits (shiftR)-import Data.List (unfoldr)-import Data.Scientific (toBoundedInteger)-import Data.String (IsString(..))-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.Text (Text)-import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf16BE)-import Data.Text.Encoding.Error (UnicodeException)-import qualified Data.Vector as V-import Data.Word (Word16, Word8)-import Numeric (showHex)-import System.IO.Unsafe (unsafePerformIO)-import qualified Data.Aeson as A-import qualified Data.Aeson.Types as A---- |--- Strings in PureScript are sequences of UTF-16 code units, which do not--- necessarily represent UTF-16 encoded text. For example, it is permissible--- for a string to contain *lone surrogates,* i.e. characters in the range--- U+D800 to U+DFFF which do not appear as a part of a surrogate pair.------ The Show instance for PSString produces a string literal which would--- represent the same data were it inserted into a PureScript source file.------ Because JSON parsers vary wildly in terms of how they deal with lone--- surrogates in JSON strings, the ToJSON instance for PSString produces JSON--- strings where that would be safe (i.e. when there are no lone surrogates),--- and arrays of UTF-16 code units (integers) otherwise.----newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }-  deriving (Eq, Ord, Semigroup, Monoid, Generic)--instance NFData PSString-instance Serialise PSString--instance Show PSString where-  show = show . codePoints---- |--- Decode a PSString to a String, representing any lone surrogates as the--- reserved code point with that index. Warning: if there are any lone--- surrogates, converting the result to Text via Data.Text.pack will result in--- loss of information as those lone surrogates will be replaced with U+FFFD--- REPLACEMENT CHARACTER. Because this function requires care to use correctly,--- we do not export it.----codePoints :: PSString -> String-codePoints = map (either (Char.chr . fromIntegral) id) . decodeStringEither---- |--- Decode a PSString as UTF-16 text. Lone surrogates will be replaced with--- U+FFFD REPLACEMENT CHARACTER----decodeStringWithReplacement :: PSString -> String-decodeStringWithReplacement = map (either (const '\xFFFD') id) . decodeStringEither---- |--- Decode a PSString as UTF-16. Lone surrogates in the input are represented in--- the output with the Left constructor; characters which were successfully--- decoded are represented with the Right constructor.----decodeStringEither :: PSString -> [Either Word16 Char]-decodeStringEither = unfoldr decode . toUTF16CodeUnits-  where-  decode :: [Word16] -> Maybe (Either Word16 Char, [Word16])-  decode (h:l:rest) | isLead h && isTrail l = Just (Right (unsurrogate h l), rest)-  decode (c:rest) | isSurrogate c = Just (Left c, rest)-  decode (c:rest) = Just (Right (toChar c), rest)-  decode [] = Nothing--  unsurrogate :: Word16 -> Word16 -> Char-  unsurrogate h l = toEnum ((toInt h - 0xD800) * 0x400 + (toInt l - 0xDC00) + 0x10000)---- |--- Attempt to decode a PSString as UTF-16 text. This will fail (returning--- Nothing) if the argument contains lone surrogates.----decodeString :: PSString -> Maybe Text-decodeString = hush . decodeEither . BS.pack . concatMap unpair . toUTF16CodeUnits-  where-  unpair w = [highByte w, lowByte w]--  lowByte :: Word16 -> Word8-  lowByte = fromIntegral--  highByte :: Word16 -> Word8-  highByte = fromIntegral . (`shiftR` 8)--  -- Based on a similar function from Data.Text.Encoding for utf8. This is a-  -- safe usage of unsafePerformIO because there are no side effects after-  -- handling any thrown UnicodeExceptions.-  decodeEither :: ByteString -> Either UnicodeException Text-  decodeEither = unsafePerformIO . try . evaluate . decodeUtf16BE--  hush = either (const Nothing) Just--instance IsString PSString where-  fromString a = PSString $ concatMap encodeUTF16 a-    where-    surrogates :: Char -> (Word16, Word16)-    surrogates c = (toWord (h + 0xD800), toWord (l + 0xDC00))-      where (h, l) = divMod (fromEnum c - 0x10000) 0x400--    encodeUTF16 :: Char -> [Word16]-    encodeUTF16 c | fromEnum c > 0xFFFF = [high, low]-      where (high, low) = surrogates c-    encodeUTF16 c = [toWord $ fromEnum c]--instance A.ToJSON PSString where-  toJSON str =-    case decodeString str of-      Just t -> A.toJSON t-      Nothing -> A.toJSON (toUTF16CodeUnits str)--instance A.FromJSON PSString where-  parseJSON a = jsonString <|> arrayOfCodeUnits-    where-    jsonString = fromString <$> A.parseJSON a--    arrayOfCodeUnits = PSString <$> parseArrayOfCodeUnits a--    parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]-    parseArrayOfCodeUnits = A.withArray "array of UTF-16 code units" (traverse parseCodeUnit . V.toList)--    parseCodeUnit :: A.Value -> A.Parser Word16-    parseCodeUnit b = A.withScientific "two-byte non-negative integer" (maybe (A.typeMismatch "" b) return . toBoundedInteger) b---- |--- Pretty print a PSString, using PureScript escape sequences.----prettyPrintString :: PSString -> Text-prettyPrintString s = "\"" <> foldMap encodeChar (decodeStringEither s) <> "\""-  where-  encodeChar :: Either Word16 Char -> Text-  encodeChar (Left c) = "\\x" <> showHex' 6 c-  encodeChar (Right c)-    | c == '\t' = "\\t"-    | c == '\r' = "\\r"-    | c == '\n' = "\\n"-    | c == '"'  = "\\\""-    | c == '\''  = "\\\'"-    | c == '\\' = "\\\\"-    | shouldPrint c = T.singleton c-    | otherwise = "\\x" <> showHex' 6 (Char.ord c)--  -- Note we do not use Data.Char.isPrint here because that includes things-  -- like zero-width spaces and combining punctuation marks, which could be-  -- confusing to print unescaped.-  shouldPrint :: Char -> Bool-  -- The standard space character, U+20 SPACE, is the only space char we should-  -- print without escaping-  shouldPrint ' ' = True-  shouldPrint c =-    Char.generalCategory c `elem`-      [ Char.UppercaseLetter-      , Char.LowercaseLetter-      , Char.TitlecaseLetter-      , Char.OtherLetter-      , Char.DecimalNumber-      , Char.LetterNumber-      , Char.OtherNumber-      , Char.ConnectorPunctuation-      , Char.DashPunctuation-      , Char.OpenPunctuation-      , Char.InitialQuote-      , Char.FinalQuote-      , Char.OtherPunctuation-      , Char.MathSymbol-      , Char.CurrencySymbol-      , Char.ModifierSymbol-      , Char.OtherSymbol-      ]---- |--- Pretty print a PSString, using JavaScript escape sequences. Intended for--- use in compiled JS output.----prettyPrintStringJS :: PSString -> Text-prettyPrintStringJS s = "\"" <> foldMap encodeChar (toUTF16CodeUnits s) <> "\""-  where-  encodeChar :: Word16 -> Text-  encodeChar c | c > 0xFF = "\\u" <> showHex' 4 c-  encodeChar c | c > 0x7E || c < 0x20 = "\\x" <> showHex' 2 c-  encodeChar c | toChar c == '\b' = "\\b"-  encodeChar c | toChar c == '\t' = "\\t"-  encodeChar c | toChar c == '\n' = "\\n"-  encodeChar c | toChar c == '\v' = "\\v"-  encodeChar c | toChar c == '\f' = "\\f"-  encodeChar c | toChar c == '\r' = "\\r"-  encodeChar c | toChar c == '"'  = "\\\""-  encodeChar c | toChar c == '\\' = "\\\\"-  encodeChar c = T.singleton $ toChar c--showHex' :: Enum a => Int -> a -> Text-showHex' width c =-  let hs = showHex (fromEnum c) "" in-  T.pack (replicate (width - length hs) '0' <> hs)--isLead :: Word16 -> Bool-isLead h = h >= 0xD800 && h <= 0xDBFF--isTrail :: Word16 -> Bool-isTrail l = l >= 0xDC00 && l <= 0xDFFF--isSurrogate :: Word16 -> Bool-isSurrogate c = isLead c || isTrail c--toChar :: Word16 -> Char-toChar = toEnum . fromIntegral--toWord :: Int -> Word16-toWord = fromIntegral--toInt :: Word16 -> Int-toInt = fromIntegral--mkString :: Text -> PSString-mkString = fromString . T.unpack
src/Language/PureScript/Pretty.hs view
@@ -7,7 +7,6 @@ -- * [@Language.PureScript.Pretty.Types@] Pretty printer for types module Language.PureScript.Pretty (module P) where -import Language.PureScript.Pretty.Kinds as P import Language.PureScript.Pretty.Types as P import Language.PureScript.Pretty.Values as P import Language.PureScript.PSString as P (prettyPrintString)
src/Language/PureScript/Pretty/Common.hs view
@@ -114,7 +114,7 @@ emptyPrinterState = PrinterState { indent = 0 }  -- |--- Number of characters per identation level+-- Number of characters per indentation level -- blockIndent :: Int blockIndent = 4
− src/Language/PureScript/Pretty/Kinds.hs 
@@ -1,57 +0,0 @@--- |--- Pretty printer for kinds----module Language.PureScript.Pretty.Kinds-  ( prettyPrintKind-  ) where--import Prelude.Compat--import Control.Arrow (ArrowPlus(..))-import Control.PatternArrows as PA--import Data.Maybe (fromMaybe)-import qualified Data.Text as T-import Data.Text (Text)--import Language.PureScript.Crash-import Language.PureScript.Kinds-import Language.PureScript.Names-import Language.PureScript.Pretty.Common--typeLiterals :: Pattern () (Kind a) Text-typeLiterals = mkPattern match-  where-  match (KUnknown _ u) =-    Just $ T.cons 'k' (T.pack (show u))-  match (NamedKind _ name) =-    Just $ if isQualifiedWith (moduleNameFromString "Prim") name-      then runProperName (disqualify name)-      else showQualified runProperName name-  match _ = Nothing--matchRow :: Pattern () (Kind a) ((), Kind a)-matchRow = mkPattern match-  where-  match (Row _ k) = Just ((), k)-  match _ = Nothing--funKind :: Pattern () (Kind a) (Kind a, Kind a)-funKind = mkPattern match-  where-  match (FunKind _ arg ret) = Just (arg, ret)-  match _ = Nothing---- | Generate a pretty-printed string representing a Kind-prettyPrintKind :: Kind a -> Text-prettyPrintKind-  = fromMaybe (internalError "Incomplete pattern")-  . PA.pattern matchKind ()-  where-  matchKind :: Pattern () (Kind a) Text-  matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parensT matchKind)--  operators :: OperatorTable () (Kind a) Text-  operators =-    OperatorTable [ [ Wrap matchRow $ \_ k -> "# " <> k]-                  , [ AssocR funKind $ \arg ret -> arg <> " -> " <> ret ] ]
src/Language/PureScript/Pretty/Types.hs view
@@ -22,17 +22,14 @@ import Control.Arrow ((<+>)) import Control.PatternArrows as PA -import Data.Functor (($>)) import Data.Maybe (fromMaybe, catMaybes) import Data.Text (Text) import qualified Data.Text as T  import Language.PureScript.Crash import Language.PureScript.Environment-import Language.PureScript.Kinds import Language.PureScript.Names import Language.PureScript.Pretty.Common-import Language.PureScript.Pretty.Kinds import Language.PureScript.Types import Language.PureScript.PSString (PSString, prettyPrintString, decodeString) import Language.PureScript.Label (Label(..))@@ -48,17 +45,18 @@   | PPTypeOp (Qualified (OpName 'TypeOpName))   | PPSkolem Text Int   | PPTypeApp PrettyPrintType PrettyPrintType+  | PPKindArg PrettyPrintType   | PPConstrainedType PrettyPrintConstraint PrettyPrintType-  | PPKindedType PrettyPrintType (Kind ())+  | PPKindedType PrettyPrintType PrettyPrintType   | PPBinaryNoParensType PrettyPrintType PrettyPrintType PrettyPrintType   | PPParensInType PrettyPrintType-  | PPForAll [(Text, Maybe (Kind ()))] PrettyPrintType+  | PPForAll [(Text, Maybe PrettyPrintType)] PrettyPrintType   | PPFunction PrettyPrintType PrettyPrintType   | PPRecord [(Label, PrettyPrintType)] (Maybe PrettyPrintType)   | PPRow [(Label, PrettyPrintType)] (Maybe PrettyPrintType)   | PPTruncated -type PrettyPrintConstraint = (Qualified (ProperName 'ClassName), [PrettyPrintType])+type PrettyPrintConstraint = (Qualified (ProperName 'ClassName), [PrettyPrintType], [PrettyPrintType])  convertPrettyPrintType :: Int -> Type a -> PrettyPrintType convertPrettyPrintType = go@@ -69,28 +67,29 @@   go _ (TypeWildcard _ n) = PPTypeWildcard n   go _ (TypeConstructor _ c) = PPTypeConstructor c   go _ (TypeOp _ o) = PPTypeOp o-  go _ (Skolem _ t n _) = PPSkolem t n+  go _ (Skolem _ t _ n _) = PPSkolem t n   go _ (REmpty _) = PPRow [] Nothing   -- Guard the remaining "complex" type atoms on the current depth value. The   -- prior  constructors can all be printed simply so it's not really helpful to   -- truncate them.   go d _ | d < 0 = PPTruncated-  go d (ConstrainedType _ (Constraint _ cls args _) ty) = PPConstrainedType (cls, go (d-1) <$> args) (go d ty)-  go d (KindedType _ ty k) = PPKindedType (go (d-1) ty) (k $> ())+  go d (ConstrainedType _ (Constraint _ cls kargs args _) ty) = PPConstrainedType (cls, go (d-1) <$> kargs, go (d-1) <$> args) (go d ty)+  go d (KindedType _ ty k) = PPKindedType (go (d-1) ty) (go (d-1) k)   go d (BinaryNoParensType _ ty1 ty2 ty3) = PPBinaryNoParensType (go (d-1) ty1) (go (d-1) ty2) (go (d-1) ty3)   go d (ParensInType _ ty) = PPParensInType (go (d-1) ty)   go d ty@RCons{} = uncurry PPRow (goRow d ty)-  go d (ForAll _ v mbK ty _) = goForAll d [(v, fmap ($> ()) mbK)] ty+  go d (ForAll _ v mbK ty _) = goForAll d [(v, fmap (go (d-1)) mbK)] ty   go d (TypeApp _ a b) = goTypeApp d a b+  go d (KindApp _ a b) = PPTypeApp (go (d-1) a) (PPKindArg (go (d-1) b)) -  goForAll d vs (ForAll _ v mbK ty _) = goForAll d ((v, fmap ($> ()) mbK) : vs) ty-  goForAll d vs ty = PPForAll vs (go (d-1) ty)+  goForAll d vs (ForAll _ v mbK ty _) = goForAll d ((v, fmap (go (d-1)) mbK) : vs) ty+  goForAll d vs ty = PPForAll (reverse vs) (go (d-1) ty)    goRow d ty =     let (items, tail_) = rowToSortedList ty     in ( map (\item -> (rowListLabel item, go (d-1) (rowListType item))) items        , case tail_ of-           REmpty _ -> Nothing+           REmptyKinded _ _ -> Nothing            _ -> Just (go (d-1) tail_)        ) @@ -110,7 +109,7 @@     doubleRightArrow = if troUnicode tro then "⇒" else "=>"  constraintAsBox :: PrettyPrintConstraint -> Box-constraintAsBox (pn, tys) = typeAsBox' (foldl PPTypeApp (PPTypeConstructor (fmap coerceProperName pn)) tys)+constraintAsBox (pn, ks, tys) = typeAsBox' (foldl PPTypeApp (foldl (\a b -> PPTypeApp a (PPKindArg b)) (PPTypeConstructor (fmap coerceProperName pn)) ks) tys)  -- | -- Generate a pretty-printed string representing a Row@@ -145,16 +144,22 @@   match (PPTypeApp f x) = Just (f, x)   match _ = Nothing +kindArg :: Pattern () PrettyPrintType ((), PrettyPrintType)+kindArg = mkPattern match+  where+  match (PPKindArg ty) = Just ((), ty)+  match _ = Nothing+ appliedFunction :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType) appliedFunction = mkPattern match   where   match (PPFunction arg ret) = Just (arg, ret)   match _ = Nothing -kinded :: Pattern () PrettyPrintType (Kind (), PrettyPrintType)+kinded :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType) kinded = mkPattern match   where-  match (PPKindedType t k) = Just (k, t)+  match (PPKindedType t k) = Just (t, k)   match _ = Nothing  constrained :: Pattern () PrettyPrintType (PrettyPrintConstraint, PrettyPrintType)@@ -197,19 +202,22 @@ matchType tro = buildPrettyPrinter operators (matchTypeAtom tro) where   operators :: OperatorTable () PrettyPrintType Box   operators =-    OperatorTable [ [ AssocL typeApp $ \f x -> keepSingleLinesOr (moveRight 2) f x ]+    OperatorTable [ [ Wrap kindArg $ \_ ty -> text "@" <> ty ]+                  , [ AssocL typeApp $ \f x -> keepSingleLinesOr (moveRight 2) f x ]                   , [ AssocR appliedFunction $ \arg ret -> keepSingleLinesOr id arg (text rightArrow <> " " <> ret) ]                   , [ Wrap constrained $ \deps ty -> constraintsAsBox tro deps ty ]-                  , [ Wrap forall_ $ \idents ty -> keepSingleLinesOr (moveRight 2) (text (forall' ++ " " ++ unwords (fmap printMbKindedType idents) ++ ".")) ty ]-                  , [ Wrap kinded $ \k ty -> keepSingleLinesOr (moveRight 2) ty (text (doubleColon ++ " " ++ T.unpack (prettyPrintKind k))) ]+                  , [ Wrap forall_ $ \idents ty -> keepSingleLinesOr (moveRight 2) (hsep 1 top (text forall' : fmap printMbKindedType idents) <> text ".") ty ]+                  , [ Wrap kinded $ \ty k -> keepSingleLinesOr (moveRight 2) (typeAsBox' ty) (text (doubleColon ++ " ") <> k) ]                   , [ Wrap explicitParens $ \_ ty -> ty ]                   ]    rightArrow = if troUnicode tro then "→" else "->"   forall' = if troUnicode tro then "∀" else "forall"   doubleColon = if troUnicode tro then "∷" else "::"-  printMbKindedType (v, mbK) = maybe v (\k -> unwords ["(" ++ v, doubleColon, T.unpack (prettyPrintKind k) ++ ")"]) mbK +  printMbKindedType (v, Nothing) = text v+  printMbKindedType (v, Just k) = text ("(" ++ v ++ " " ++ doubleColon ++ " ") <> typeAsBox' k <> text ")"+   -- If both boxes span a single line, keep them on the same line, or else   -- use the specified function to modify the second box, then combine vertically.   keepSingleLinesOr :: (Box -> Box) -> Box -> Box -> Box@@ -217,7 +225,7 @@     | rows b1 > 1 || rows b2 > 1 = vcat left [ b1, f b2 ]     | otherwise = hcat top [ b1, text " ", b2] -forall_ :: Pattern () PrettyPrintType ([(String, Maybe (Kind ()))], PrettyPrintType)+forall_ :: Pattern () PrettyPrintType ([(String, Maybe PrettyPrintType)], PrettyPrintType) forall_ = mkPattern match   where   match (PPForAll idents ty) = Just (map (\(v, mbK) -> (T.unpack v, mbK)) idents, ty)
src/Language/PureScript/Pretty/Values.hs view
@@ -87,7 +87,8 @@ prettyPrintValue d (Ado m els yield) =   textT (maybe "" ((Monoid.<> ".") . runModuleName) m) <> text "ado " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els) //   (text "in " <> prettyPrintValue (d - 1) yield)-prettyPrintValue d (TypeClassDictionary (Constraint _ name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ T.unpack (runProperName (disqualify name))) : map (typeAtomAsBox d) tys+-- TODO: constraint kind args+prettyPrintValue d (TypeClassDictionary (Constraint _ name _ tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ T.unpack (runProperName (disqualify name))) : map (typeAtomAsBox d) tys prettyPrintValue _ (DeferredDictionary name _) = text $ "#dict " ++ T.unpack (runProperName (disqualify name)) prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =     text "#dict-accessor " <> text (T.unpack (runProperName (disqualify className))) <> text "." <> text (T.unpack (showIdent ident)) <> text ">"
src/Language/PureScript/Publish.hs view
@@ -25,11 +25,11 @@ import Control.Category ((>>>)) import Control.Monad.Writer.Strict (MonadWriter, WriterT, runWriterT, tell) -import Data.Aeson.BetterErrors (Parse, parse, keyMay, eachInObjectWithKey, eachInObject, key, keyOrDefault, asBool, asString, withString, asText, withText)+import Data.Aeson.BetterErrors (Parse, parse, keyMay, eachInObjectWithKey, key, asString, withString) import qualified Data.ByteString.Lazy as BL import Data.Char (isSpace) import Data.String (String, lines)-import Data.List (stripPrefix, (\\), nubBy)+import Data.List (stripPrefix, (\\)) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Text as T import Data.Time.Clock (UTCTime)@@ -297,12 +297,7 @@     Right res ->       pure res     Left err ->-      case parse asLegacyResolutions depsBS of-        Right res -> do-          warn $ LegacyResolutionsFormat resolutionsFile-          pure res-        Left _ ->-          userError $ ResolutionsFileError resolutionsFile err+      userError $ ResolutionsFileError resolutionsFile err  -- | Parser for resolutions files, which contain information about the packages -- which this package depends on. A resolutions file should look something like@@ -337,47 +332,6 @@ asVersion :: Parse D.PackageError Version asVersion =   withString (note D.InvalidVersion . P.parseVersion')---- | Extracts all dependencies and their versions from a legacy resolutions--- file, which is based on the output of `bower list --json --offline`.-asLegacyResolutions :: Parse D.PackageError [(PackageName, (FilePath, DependencyStatus))]-asLegacyResolutions =-  nubBy ((==) `on` fst) <$> go True-  where-  go isToplevel =-    keyDependencies isToplevel $-        (++) <$> (takeJusts <$> eachInObjectWithKey parsePackageName asDirectoryAndDependencyStatus)-             <*> (concatMap snd <$> eachInObject (go False))---  keyDependencies isToplevel =-    if isToplevel-      then key "dependencies"-      else fmap (fromMaybe []) . keyMay "dependencies"--  takeJusts :: [(a, Maybe b)] -> [(a,b)]-  takeJusts = mapMaybe $ \(x,y) -> (x,) <$> y--  asDirectoryAndDependencyStatus :: Parse D.PackageError (Maybe (FilePath, DependencyStatus))-  asDirectoryAndDependencyStatus = do-    isMissing <- keyOrDefault "missing" False asBool-    if isMissing-      then return Nothing-      else do-        directory <- key "canonicalDir" asString-        status <- key "pkgMeta" $-           keyOrDefault "_resolution" NoResolution $ do-             type_ <- key "type" asText-             case type_ of-              "version" ->-                key "tag" $ fmap ResolvedVersion $ withText $ \tag ->-                  let-                    tag' = fromMaybe tag (T.stripPrefix "v" tag)-                  in-                    note D.InvalidVersion (P.parseVersion' (T.unpack tag'))-              other ->-                return (ResolvedOther other)-        return $ Just (directory, status)  parsePackageName :: Text -> Either D.PackageError PackageName parsePackageName = first D.ErrorInPackageMeta . Bower.parsePackageName
src/Language/PureScript/Publish/ErrorsWarnings.hs view
@@ -21,8 +21,7 @@ import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe-import Data.Monoid hiding (First, getFirst)-import Data.Semigroup (First(..))+import Data.Monoid import Data.Version import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text)@@ -46,7 +45,6 @@   = NoResolvedVersion PackageName   | UnacceptableVersion (PackageName, Text)   | DirtyWorkingTree_Warn-  | LegacyResolutionsFormat FilePath   deriving (Show)  -- | An error that should be fixed by the user.@@ -159,7 +157,7 @@           [ "The currently checked out commit seems to have been tagged with "           , "more than 1 version, and I don't know which one should be used. "           , "Please either delete some of the tags, or create a new commit "-          , "to tag the desired verson with."+          , "to tag the desired version with."           ])       , spacer       , para "Tags for the currently checked out commit:"@@ -168,32 +166,37 @@     displayRepositoryError err   NoLicenseSpecified ->     vcat $-      [ para (concat-          [ "No license is specified in package manifest. Please add one, using the "-          , "SPDX license expression format. For example, any of the "-          , "following would be acceptable:"-          ])+      [ para $ concat+          [ "No license is specified in package manifest. Please add a "+          , "\"license\" property with a SPDX license expression. For example, "+          , "any of the following would be acceptable:"+          ]       , spacer       ] ++ spdxExamples ++       [ spacer-      , para (-          "Note that distributing code without a license means that nobody "-          ++ "will (legally) be able to use it."-          )+      , para $ concat+          [ "See https://spdx.org/licenses/ for a full list of licenses. For more "+          , "information on SPDX license expressions, see https://spdx.org/ids-how"+          ]       , spacer-      , para (concat+      , para $ concat+          [ "Note that distributing code without a license means that nobody will "+          , "(legally) be able to use it."+          ]+      , spacer+      , para $ concat           [ "It is also recommended to add a LICENSE file to the repository, "-          , "including your name and the current year, although this is not "-          , "necessary."-          ])+          , "including your name and the current year, although this is not necessary."+          ]       ]   InvalidLicense ->     vcat $-      [ para (concat-          [ "The license specified in package manifest is not a valid SPDX license "-          , "expression. Please use the SPDX license expression format. For "-          , "example, any of the following would be acceptable:"-          ])+      [ para $ concat+          [ "The license specified in package manifest is not a valid SPDX "+          , "license expression. Please update the \"license\" property so that "+          , "it is a valid SPDX license expression. For example, any of the "+          , "following would be acceptable:"+          ]       , spacer       ] ++       spdxExamples@@ -230,8 +233,8 @@     [ "* \"MIT\""     , "* \"Apache-2.0\""     , "* \"BSD-2-Clause\""-    , "* \"GPL-2.0+\""-    , "* \"(GPL-3.0 OR MIT)\""+    , "* \"GPL-2.0-or-later\""+    , "* \"(GPL-3.0-only OR MIT)\""     ]  displayRepositoryError :: RepositoryFieldError -> Box@@ -297,16 +300,15 @@   { noResolvedVersions      :: [PackageName]   , unacceptableVersions    :: [(PackageName, Text)]   , dirtyWorkingTree        :: Any-  , legacyResolutionsFormat :: Maybe (First FilePath)   }   deriving (Show, Eq, Ord)  instance Semigroup CollectedWarnings where-  (<>) (CollectedWarnings a b c d) (CollectedWarnings a' b' c' d') =-    CollectedWarnings (a <> a') (b <> b') (c <> c') (d <> d')+  (<>) (CollectedWarnings a b c) (CollectedWarnings a' b' c') =+    CollectedWarnings (a <> a') (b <> b') (c <> c')  instance Monoid CollectedWarnings where-  mempty = CollectedWarnings mempty mempty mempty mempty+  mempty = CollectedWarnings mempty mempty mempty  collectWarnings :: [PackageWarning] -> CollectedWarnings collectWarnings = foldMap singular@@ -318,8 +320,6 @@       mempty { unacceptableVersions = [t] }     DirtyWorkingTree_Warn ->       mempty { dirtyWorkingTree = Any True }-    LegacyResolutionsFormat path ->-      mempty { legacyResolutionsFormat = Just (First path) }  renderWarnings :: [PackageWarning] -> Box renderWarnings warns =@@ -330,7 +330,6 @@                , if getAny dirtyWorkingTree                    then Just warnDirtyWorkingTree                    else Nothing-               , fmap (warnLegacyResolutions . getFirst) legacyResolutionsFormat                ]   in case catMaybes mboxes of        []    -> nullBox@@ -395,21 +394,6 @@     "Your working tree is dirty. (Note: this would be an error if it "     ++ "were not a dry run)"     )--warnLegacyResolutions :: FilePath -> Box-warnLegacyResolutions path =-  vcat $-    [ para (concat-        [ "Your resolutions file (" ++ path ++ ") is using the deprecated "-        , "legacy format. Support for this format will be dropped in a future "-        , "version."-        ])-    , spacer-    , para (concat-        [ "In most cases, all you need to do to use the new format and silence "-        , "this warning is to upgrade Pulp."-        ])-    ]  printWarnings :: [PackageWarning] -> IO () printWarnings = printToStderr . renderWarnings
src/Language/PureScript/Renamer.hs view
@@ -109,7 +109,7 @@ renameInModules = map go   where   go :: Module Ann -> Module Ann-  go m@(Module _ _ _ _ _ _ _ decls) = m { moduleDecls = map (renameInDecl' (findDeclIdents decls)) decls }+  go m@(Module _ _ _ _ _ _ _ _ decls) = m { moduleDecls = map (renameInDecl' (findDeclIdents decls)) decls }    renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann   renameInDecl' scope = runRename scope . renameInDecl True
src/Language/PureScript/Sugar.hs view
@@ -3,18 +3,23 @@ -- module Language.PureScript.Sugar (desugar, module S) where +import Prelude+ import Control.Category ((>>>)) import Control.Monad-import Control.Monad.Error.Class (MonadError())-import Control.Monad.Supply.Class-import Control.Monad.Writer.Class (MonadWriter())+import Control.Monad.Error.Class (MonadError)+import Control.Monad.Supply.Class (MonadSupply)+import Control.Monad.State.Class (MonadState)+import Control.Monad.Writer.Class (MonadWriter)+import Data.Maybe (mapMaybe) -import Data.List (map)-import Data.Traversable (traverse)+import qualified Data.Map as M  import Language.PureScript.AST import Language.PureScript.Errors import Language.PureScript.Externs+import Language.PureScript.Linter.Imports+import Language.PureScript.Names import Language.PureScript.Sugar.BindingGroups as S import Language.PureScript.Sugar.CaseDeclarations as S import Language.PureScript.Sugar.DoNotation as S@@ -26,6 +31,7 @@ import Language.PureScript.Sugar.TypeClasses as S import Language.PureScript.Sugar.TypeClasses.Deriving as S import Language.PureScript.Sugar.TypeDeclarations as S+import Language.PureScript.TypeChecker.Synonyms (SynonymMap)  -- | -- The desugaring pipeline proceeds as follows:@@ -53,22 +59,43 @@ --  * Group mutually recursive value and data declarations into binding groups. -- desugar-  :: (MonadSupply m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => Env-  -> [ExternsFile]-  -> [Module]-  -> m [Module]-desugar env externs =-  map desugarSignedLiterals-    >>> traverse desugarObjectConstructors-    >=> traverse desugarDoModule-    >=> traverse desugarAdoModule-    >=> map desugarLetPatternModule-    >>> traverse desugarCasesModule-    >=> traverse desugarTypeDeclarationsModule-    >=> desugarImports env+  :: MonadSupply m+  => MonadError MultipleErrors m+  => MonadWriter MultipleErrors m+  => MonadState (Env, UsedImports) m+  => [ExternsFile]+  -> Module+  -> m Module+desugar externs =+  desugarSignedLiterals+    >>> desugarObjectConstructors+    >=> desugarDoModule+    >=> desugarAdoModule+    >=> desugarLetPatternModule+    >>> desugarCasesModule+    >=> desugarTypeDeclarationsModule+    >=> desugarImports     >=> rebracket externs-    >=> traverse checkFixityExports-    >=> traverse (deriveInstances externs)-    >=> desugarTypeClasses externs-    >=> traverse createBindingGroupsModule+    >=> checkFixityExports+    >=> (\m ->+      -- We need to collect type synonym information, since synonyms will not be+      -- removed until later, during type checking.+      let syns = findTypeSynonyms externs (getModuleName m) $ getModuleDeclarations m+      -- We cannot prevent ill-kinded expansions of type synonyms without+      -- knowing their kinds but they're not available yet.+          kinds = mempty+       in deriveInstances externs syns kinds m+      >>= desugarTypeClasses externs syns kinds)+    >=> createBindingGroupsModule++findTypeSynonyms :: [ExternsFile] -> ModuleName -> [Declaration] -> SynonymMap+findTypeSynonyms externs mn decls =+    M.fromList $ (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)+              ++ mapMaybe fromLocalDecl decls+  where+    fromExternsDecl mn' (EDTypeSynonym name args ty) = Just (Qualified (Just mn') name, (args, ty))+    fromExternsDecl _ _ = Nothing++    fromLocalDecl (TypeSynonymDeclaration _ name args ty) =+      Just (Qualified (Just mn) name, (args, ty))+    fromLocalDecl _ = Nothing
src/Language/PureScript/Sugar/AdoNotation.hs view
@@ -14,7 +14,7 @@ import           Language.PureScript.AST import           Language.PureScript.Errors import           Language.PureScript.Names-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C  -- | Replace all @AdoNotationBind@ and @AdoNotationValue@ constructors with -- applications of the pure and apply functions in scope, and all @AdoNotationLet@
src/Language/PureScript/Sugar/BindingGroups.hs view
@@ -12,11 +12,12 @@ import Prelude.Compat import Protolude (ordNub) -import Control.Monad ((<=<))+import Control.Monad ((<=<), guard) import Control.Monad.Error.Class (MonadError(..))  import Data.Graph import Data.List (intersect)+import Data.Foldable (find) import Data.Maybe (isJust, mapMaybe) import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S@@ -28,6 +29,11 @@ import Language.PureScript.Names import Language.PureScript.Types +data VertexType+  = VertexDefinition+  | VertexKindSignature+  deriving (Eq, Ord, Show)+ -- | -- Replace all sets of mutually-recursive declarations in a module with binding groups --@@ -67,19 +73,36 @@   handleDecls :: [Declaration] -> m [Declaration]   handleDecls ds = do     let values = mapMaybe (fmap (fmap extractGuardedExpr) . getValueDeclaration) ds-        dataDecls = filter isDataDecl ds-        allProperNames = fmap declTypeName dataDecls-        dataVerts = fmap (\d -> (d, declTypeName d, usedTypeNames moduleName d `intersect` allProperNames)) dataDecls-    dataBindingGroupDecls <- parU (stronglyConnComp dataVerts) toDataBindingGroup+        kindDecls = fmap (,VertexKindSignature) $ filter (\a -> isKindDecl a || isExternDataDecl a) ds+        dataDecls = fmap (,VertexDefinition) $ filter (\a -> isDataDecl a || isTypeSynonymDecl a || isTypeClassDecl a) ds+        kindSigs = fmap (declTypeName . fst) kindDecls+        typeSyns = fmap declTypeName $ filter isTypeSynonymDecl ds+        allDecls = kindDecls ++ dataDecls+        allProperNames = fmap (declTypeName . fst) allDecls+        mkVert (d, vty) =+          let names = usedTypeNames moduleName d `intersect` allProperNames+              name = declTypeName d+              -- If a dependency has a kind signature, than that's all we need to depend on, except+              -- in the case that we are defining a kind signature and using a type synonym. In order+              -- to expand the type synonym, we must depend on the synonym declaration itself.+              vtype n+                | vty == VertexKindSignature && n `elem` typeSyns = VertexDefinition+                | n `elem` kindSigs = VertexKindSignature+                | otherwise = VertexDefinition+              deps = fmap (\n -> (n, vtype n)) names+              self+                | vty == VertexDefinition && name `elem` kindSigs = [(name, VertexKindSignature)]+                | otherwise = []+          in (d, (name, vty), self ++ deps)+        dataVerts = fmap mkVert allDecls+    dataBindingGroupDecls <- parU (stronglyConnCompR dataVerts) toDataBindingGroup     let allIdents = fmap valdeclIdent values         valueVerts = fmap (\d -> (d, valdeclIdent d, usedIdents moduleName d `intersect` allIdents)) values     bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)     return $ filter isImportDecl ds ++-             filter isExternKindDecl ds ++-             filter isExternDataDecl ds +++             filter isRoleDecl ds ++              dataBindingGroupDecls ++-             filter isTypeClassDeclaration ds ++-             filter isTypeClassInstanceDeclaration ds +++             filter isTypeClassInstanceDecl ds ++              filter isFixityDecl ds ++              filter isExternDecl ds ++              bindingGroupDecls@@ -134,23 +157,34 @@   usedNamesE scope _ = (scope, [])  usedTypeNames :: ModuleName -> Declaration -> [ProperName 'TypeName]-usedTypeNames moduleName =-  let (f, _, _, _, _) = accumTypes (everythingOnTypes (++) usedNames)-  in ordNub . f+usedTypeNames moduleName = go   where+  (f, _, _, _, _) = accumTypes (everythingOnTypes (++) usedNames)++  go :: Declaration -> [ProperName 'TypeName]+  go decl = ordNub (f decl <> usedNamesForTypeClassDeps decl)+   usedNames :: SourceType -> [ProperName 'TypeName]-  usedNames (ConstrainedType _ con _) =-    case con of-      (Constraint _ (Qualified (Just moduleName') name) _ _)-        | moduleName == moduleName' -> [coerceProperName name]-      _ -> []+  usedNames (ConstrainedType _ con _) = usedConstraint con   usedNames (TypeConstructor _ (Qualified (Just moduleName') name))     | moduleName == moduleName' = [name]   usedNames _ = [] +  usedConstraint :: SourceConstraint -> [ProperName 'TypeName]+  usedConstraint (Constraint _ (Qualified (Just moduleName') name) _ _ _)+    | moduleName == moduleName' = [coerceProperName name]+  usedConstraint _ = []++  usedNamesForTypeClassDeps :: Declaration -> [ProperName 'TypeName]+  usedNamesForTypeClassDeps (TypeClassDeclaration _ _ _ deps _ _) = foldMap usedConstraint deps+  usedNamesForTypeClassDeps _ = []+ declTypeName :: Declaration -> ProperName 'TypeName declTypeName (DataDeclaration _ _ pn _ _) = pn+declTypeName (ExternDataDeclaration _ pn _) = pn declTypeName (TypeSynonymDeclaration _ pn _ _) = pn+declTypeName (TypeClassDeclaration _ pn _ _ _ _) = coerceProperName pn+declTypeName (KindDeclaration _ _ pn _) = pn declTypeName _ = internalError "Expected DataDeclaration"  -- |@@ -191,15 +225,35 @@  toDataBindingGroup   :: MonadError MultipleErrors m-  => SCC Declaration+  => SCC (Declaration, (ProperName 'TypeName, VertexType), [(ProperName 'TypeName, VertexType)])   -> m Declaration-toDataBindingGroup (AcyclicSCC d) = return d-toDataBindingGroup (CyclicSCC [d]) = case isTypeSynonym d of-  Just pn -> throwError . errorMessage' (declSourceSpan d) $ CycleInTypeSynonym (Just pn)-  _ -> return d+toDataBindingGroup (AcyclicSCC (d, _, _)) = return d toDataBindingGroup (CyclicSCC ds')-  | all (isJust . isTypeSynonym) ds' = throwError . errorMessage' (declSourceSpan (head ds')) $ CycleInTypeSynonym Nothing-  | otherwise = return . DataBindingGroupDeclaration $ NEL.fromList ds'+  | kds@((ss, _):_) <- concatMap (kindDecl . getDecl) ds' = throwError . errorMessage' ss . CycleInKindDeclaration $ fmap snd kds+  | not (null typeSynonymCycles) =+      throwError+        . MultipleErrors+        . fmap (\syns -> ErrorMessage [positionedError . declSourceSpan . getDecl $ head syns] . CycleInTypeSynonym $ fmap (fst . getName) syns)+        $ typeSynonymCycles+  | otherwise = return . DataBindingGroupDeclaration . NEL.fromList $ getDecl <$> ds'+  where+  kindDecl (KindDeclaration sa _ pn _) = [(fst sa, Qualified Nothing pn)]+  kindDecl (ExternDataDeclaration sa pn _) = [(fst sa, Qualified Nothing pn)]+  kindDecl _ = []++  getDecl (decl, _, _) = decl+  getName (_, name, _) = name+  lookupVert name = find ((==) name . getName) ds'++  onlySynonyms (decl, name, deps) = do+    guard . isJust $ isTypeSynonym decl+    pure (decl, name, filter (maybe False (isJust . isTypeSynonym . getDecl) . lookupVert) deps)++  isCycle (CyclicSCC c) = Just c+  isCycle _ = Nothing++  typeSynonymCycles =+    mapMaybe isCycle . stronglyConnCompR . mapMaybe onlySynonyms $ ds'  isTypeSynonym :: Declaration -> Maybe (ProperName 'TypeName) isTypeSynonym (TypeSynonymDeclaration _ pn _ _) = Just pn
src/Language/PureScript/Sugar/CaseDeclarations.hs view
@@ -60,7 +60,7 @@ desugarGuardedExprs ss (Case scrut alternatives)   | any (not . isTrivialExpr) scrut = do     -- in case the scrutinee is non trivial (e.g. not a Var or Literal)-    -- we may evaluate the scrutinee more than once when a guard occurrs.+    -- we may evaluate the scrutinee more than once when a guard occurs.     -- We bind the scrutinee to Vars here to mitigate this case.     (scrut', scrut_decls) <- unzip <$> forM scrut (\e -> do       scrut_id <- freshIdent'@@ -252,7 +252,7 @@      -- case expressions with a single alternative which have     -- a NullBinder occur frequently after desugaring-    -- complex guards. This function removes these superflous+    -- complex guards. This function removes these superfluous     -- cases.     optimize :: Expr -> Expr     optimize (Case _ [CaseAlternative vb [MkUnguarded v]])@@ -267,8 +267,8 @@     alts' <- desugarAlternatives alternatives     return $ optimize (Case scrut alts') -desugarGuardedExprs ss (TypedValue infered e ty) =-  TypedValue infered <$> desugarGuardedExprs ss e <*> pure ty+desugarGuardedExprs ss (TypedValue inferred e ty) =+  TypedValue inferred <$> desugarGuardedExprs ss e <*> pure ty  desugarGuardedExprs _ (PositionedValue ss comms e) =   PositionedValue ss comms <$> desugarGuardedExprs ss e@@ -406,7 +406,7 @@   argName _ = freshIdent'    -- Combine two lists of potential names from two case alternatives-  -- by zipping correspoding columns.+  -- by zipping corresponding columns.   resolveNames :: [Maybe Ident] -> [Maybe Ident] -> [Maybe Ident]   resolveNames = zipWith resolveName
src/Language/PureScript/Sugar/DoNotation.hs view
@@ -16,7 +16,7 @@ import           Language.PureScript.Crash import           Language.PureScript.Errors import           Language.PureScript.Names-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C  -- | Replace all @DoNotationBind@ and @DoNotationValue@ constructors with -- applications of the bind function in scope, and all @DoNotationLet@
src/Language/PureScript/Sugar/Names.hs view
@@ -1,6 +1,5 @@ module Language.PureScript.Sugar.Names   ( desugarImports-  , desugarImportsWithEnv   , Env   , externsEnv   , primEnv@@ -13,7 +12,7 @@ import Prelude.Compat import Protolude (ordNub, sortBy, on) -import Control.Arrow (first)+import Control.Arrow (first, second) import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Lazy@@ -27,7 +26,6 @@ import Language.PureScript.Crash import Language.PureScript.Errors import Language.PureScript.Externs-import Language.PureScript.Kinds import Language.PureScript.Linter.Imports import Language.PureScript.Names import Language.PureScript.Sugar.Names.Env@@ -37,44 +35,32 @@ import Language.PureScript.Types  -- |--- Replaces all local names with qualified names within a list of modules. The--- modules should be topologically sorted beforehand.+-- Replaces all local names with qualified names. -- desugarImports   :: forall m-   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => Env-  -> [Module]-  -> m [Module]-desugarImports env modules =-  fmap snd (desugarImportsWithEnv env modules)--desugarImportsWithEnv-  :: forall m-  . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => Env-  -> [Module]-  -> m (Env, [Module])-desugarImportsWithEnv e modules = do-  (modules', env') <- first reverse <$> foldM updateEnv ([], e) modules-  (env',) <$> traverse (renameInModule' env') modules'+   . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadState (Env, UsedImports) m)+  => Module+  -> m Module+desugarImports = updateEnv >=> renameInModule'   where-  updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)-  updateEnv (ms, env) m@(Module ss _ mn _ refs) = do+  updateEnv :: Module -> m Module+  updateEnv m@(Module ss _ mn _ refs) = do     members <- findExportable m-    let env' = M.insert mn (ss, nullImports, members) env+    env' <- gets $ M.insert mn (ss, nullImports, members) . fst     (m', imps) <- resolveImports env' m     exps <- maybe (return members) (resolveExports env' ss mn imps members) refs-    return (m' : ms, M.insert mn (ss, imps, exps) env)+    modify . first $ M.insert mn (ss, imps, exps)+    return m' -  renameInModule' :: Env -> Module -> m Module-  renameInModule' env m@(Module _ _ mn _ _) =+  renameInModule' :: Module -> m Module+  renameInModule' m@(Module _ _ mn _ _) =     warnAndRethrow (addHint (ErrorInModule mn)) $ do+      env <- gets fst       let (_, imps, exps) = fromMaybe (internalError "Module is missing in renameInModule'") $ M.lookup mn env       (m', used) <- flip runStateT M.empty $ renameInModule imps m-      let m'' = elaborateExports exps m'-      lintImports m'' env used-      return m''+      modify . second $ M.unionWith (<>) used+      return $ elaborateExports exps m'  -- | Create an environment from a collection of externs files externsEnv@@ -121,9 +107,6 @@   exportedValueOps :: M.Map (OpName 'ValueOpName) ExportSource   exportedValueOps = exportedRefs getValueOpRef -  exportedKinds :: M.Map (ProperName 'KindName) ExportSource-  exportedKinds = exportedRefs getKindRef-   exportedRefs :: Ord a => (DeclarationRef -> Maybe a) -> M.Map a ExportSource   exportedRefs f =     M.fromList $ (, localExportSource) <$> mapMaybe f efExports@@ -145,7 +128,6 @@     ++ go (TypeClassRef ss) exportedTypeClasses     ++ go (ValueRef ss) exportedValues     ++ go (ValueOpRef ss) exportedValueOps-    ++ go (KindRef ss) exportedKinds     ++ maybe [] (filter isModuleRef) refs   where @@ -227,6 +209,10 @@         <*> updateClassName cn ss         <*> traverse updateTypesEverywhere ts         <*> pure ds+  updateDecl bound (KindDeclaration sa kindFor name ty) =+    fmap (bound,) $+      KindDeclaration sa kindFor name+        <$> updateTypesEverywhere ty   updateDecl bound (TypeDeclaration (TypeDeclarationData sa name ty)) =     fmap (bound,) $       TypeDeclaration . TypeDeclarationData sa name@@ -238,7 +224,7 @@   updateDecl bound (ExternDataDeclaration sa name ki) =     fmap (bound,) $       ExternDataDeclaration sa name-        <$> updateKindsEverywhere ki+        <$> updateTypesEverywhere ki   updateDecl bound (TypeFixityDeclaration sa@(ss, _) fixity alias op) =     fmap (bound,) $       TypeFixityDeclaration sa fixity@@ -316,17 +302,10 @@   letBoundVariable :: Declaration -> Maybe Ident   letBoundVariable = fmap valdeclIdent . getValueDeclaration -  updateKindsEverywhere :: SourceKind -> m SourceKind-  updateKindsEverywhere = everywhereOnKindsM updateKind-    where-    updateKind :: SourceKind -> m SourceKind-    updateKind (NamedKind ann@(ss, _) name) = NamedKind ann <$> updateKindName name ss-    updateKind k = return k-   updateTypeArguments     :: (Traversable f, Traversable g)-    => f (a, g SourceKind) -> m (f (a, g SourceKind))-  updateTypeArguments = traverse (sndM (traverse updateKindsEverywhere))+    => f (a, g SourceType) -> m (f (a, g SourceType))+  updateTypeArguments = traverse (sndM (traverse updateTypesEverywhere))    updateTypesEverywhere :: SourceType -> m SourceType   updateTypesEverywhere = everywhereOnTypesM updateType@@ -335,19 +314,16 @@     updateType (TypeOp ann@(ss, _) name) = TypeOp ann <$> updateTypeOpName name ss     updateType (TypeConstructor ann@(ss, _) name) = TypeConstructor ann <$> updateTypeName name ss     updateType (ConstrainedType ann c t) = ConstrainedType ann <$> updateInConstraint c <*> pure t-    updateType (ForAll ann v mbK t sco) = case mbK of-      Nothing -> pure $ ForAll ann v Nothing t sco-      Just k -> ForAll ann v <$> fmap pure (updateKindsEverywhere k) <*> pure t <*> pure sco-    updateType (KindedType ann t k) = KindedType ann t <$> updateKindsEverywhere k     updateType t = return t     updateInConstraint :: SourceConstraint -> m SourceConstraint-    updateInConstraint (Constraint ann@(ss, _) name ts info) =-      Constraint ann <$> updateClassName name ss <*> pure ts <*> pure info+    updateInConstraint (Constraint ann@(ss, _) name ks ts info) =+      Constraint ann <$> updateClassName name ss <*> pure ks <*> pure ts <*> pure info    updateConstraints :: SourceSpan -> [SourceConstraint] -> m [SourceConstraint]-  updateConstraints pos = traverse $ \(Constraint ann name ts info) ->+  updateConstraints pos = traverse $ \(Constraint ann name ks ts info) ->     Constraint ann       <$> updateClassName name pos+      <*> traverse updateTypesEverywhere ks       <*> traverse updateTypesEverywhere ts       <*> pure info @@ -384,14 +360,8 @@     -> m (Qualified (OpName 'ValueOpName))   updateValueOpName = update (importedValueOps imports) ValOpName -  updateKindName-    :: Qualified (ProperName 'KindName)-    -> SourceSpan-    -> m (Qualified (ProperName 'KindName))-  updateKindName = update (importedKinds imports) KiName-   -- Update names so unqualified references become qualified, and locally-  -- qualified references are replaced with their canoncial qualified names+  -- qualified references are replaced with their canonical qualified names   -- (e.g. M.Map -> Data.Map.Map).   update     :: (Ord a)
src/Language/PureScript/Sugar/Names/Common.hs view
@@ -6,7 +6,7 @@ import Control.Monad.Writer (MonadWriter(..))  import Data.Foldable (for_)-import Data.List (nub, (\\))+import Data.List (group, sort, (\\)) import Data.Maybe (mapMaybe)  import Language.PureScript.AST@@ -24,13 +24,24 @@   -> m () warnDuplicateRefs pos toError refs = do   let withoutCtors = deleteCtors `map` refs-      dupeRefs = mapMaybe (refToName pos) $ withoutCtors \\ nub withoutCtors+      dupeRefs = mapMaybe (refToName pos) $ removeUnique withoutCtors       dupeCtors = concat $ mapMaybe (extractCtors pos) refs    for_ (dupeRefs ++ dupeCtors) $ \(pos', name) ->     warnWithPosition pos' . tell . errorMessage $ toError name    where++  -- Removes all unique elements from list+  -- as well as one of each duplicate.+  -- Example:+  --  removeUnique [1,2,2,3,3,3,4] == [2,3,3]+  -- Note that it may be more correct to keep ALL duplicates,+  -- but that requires additional changes in how warnings are printed.+  -- Example of keeping all duplicates (not what this code currently does):+  --  removeUnique [1,2,2,3,3,3,4] == [2,2,3,3,3]+  removeUnique :: Eq a => Ord a => [a] -> [a]+  removeUnique = concatMap (drop 1) . group . sort    -- Deletes the constructor information from TypeRefs so that only the   -- referenced type is used in the duplicate check - constructors are handled
src/Language/PureScript/Sugar/Names/Env.hs view
@@ -17,7 +17,6 @@   , exportTypeClass   , exportValue   , exportValueOp-  , exportKind   , getExports   , checkImportConflicts   ) where@@ -36,7 +35,7 @@ import qualified Data.Map as M import qualified Data.Set as S -import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prim as C import Language.PureScript.AST import Language.PureScript.Environment import Language.PureScript.Errors@@ -112,7 +111,7 @@   -- |   -- Local names for kinds within a module mapped to their qualified names   ---  , importedKinds :: ImportMap (ProperName 'KindName)+  , importedKinds :: ImportMap (ProperName 'TypeName)   } deriving (Show)  nullImports :: Imports@@ -145,17 +144,13 @@   -- from.   --   , exportedValueOps :: M.Map (OpName 'ValueOpName) ExportSource-  -- |-  -- The exported kinds along with the module they originally came from.-  ---  , exportedKinds :: M.Map (ProperName 'KindName) ExportSource   } deriving (Show)  -- | -- An empty 'Exports' value. -- nullExports :: Exports-nullExports = Exports M.empty M.empty M.empty M.empty M.empty M.empty+nullExports = Exports M.empty M.empty M.empty M.empty M.empty  -- | -- The imports and exports for a collection of modules. The 'SourceSpan' is used@@ -186,43 +181,49 @@ -- The exported types from the @Prim@ module -- primExports :: Exports-primExports = mkPrimExports primTypes primClasses primKinds+primExports = mkPrimExports primTypes primClasses  -- | -- The exported types from the @Prim.Boolean@ module -- primBooleanExports :: Exports-primBooleanExports = mkPrimExports primBooleanTypes mempty primBooleanKinds+primBooleanExports = mkPrimExports primBooleanTypes mempty  -- |+-- The exported types from the @Prim.Coerce@ module+--+primCoerceExports :: Exports+primCoerceExports = mkPrimExports primCoerceTypes primCoerceClasses++-- | -- The exported types from the @Prim.Ordering@ module -- primOrderingExports :: Exports-primOrderingExports = mkPrimExports primOrderingTypes mempty primOrderingKinds+primOrderingExports = mkPrimExports primOrderingTypes mempty  -- | -- The exported types from the @Prim.Row@ module -- primRowExports :: Exports-primRowExports = mkPrimExports primRowTypes primRowClasses mempty+primRowExports = mkPrimExports primRowTypes primRowClasses  -- | -- The exported types from the @Prim.RowList@ module -- primRowListExports :: Exports-primRowListExports = mkPrimExports primRowListTypes primRowListClasses primRowListKinds+primRowListExports = mkPrimExports primRowListTypes primRowListClasses  -- | -- The exported types from the @Prim.Symbol@ module -- primSymbolExports :: Exports-primSymbolExports = mkPrimExports primSymbolTypes primSymbolClasses mempty+primSymbolExports = mkPrimExports primSymbolTypes primSymbolClasses  -- | -- The exported types from the @Prim.TypeError@ module -- primTypeErrorExports :: Exports-primTypeErrorExports = mkPrimExports primTypeErrorTypes primTypeErrorClasses primTypeErrorKinds+primTypeErrorExports = mkPrimExports primTypeErrorTypes primTypeErrorClasses  -- | -- Create a set of exports for a Prim module.@@ -230,18 +231,15 @@ mkPrimExports   :: M.Map (Qualified (ProperName 'TypeName)) a   -> M.Map (Qualified (ProperName 'ClassName)) b-  -> S.Set (Qualified (ProperName 'KindName))   -> Exports-mkPrimExports ts cs ks =+mkPrimExports ts cs =   nullExports     { exportedTypes = M.fromList $ mkTypeEntry `map` M.keys ts     , exportedTypeClasses = M.fromList $ mkClassEntry `map` M.keys cs-    , exportedKinds = M.fromList $ mkKindEntry `map` S.toList ks     }   where   mkTypeEntry (Qualified mn name) = (name, ([], primExportSource mn))   mkClassEntry (Qualified mn name) = (name, primExportSource mn)-  mkKindEntry (Qualified mn name) = (name, primExportSource mn)    primExportSource mn =     ExportSource@@ -258,6 +256,9 @@   , ( C.PrimBoolean     , (internalModuleSourceSpan "<Prim.Boolean>", nullImports, primBooleanExports)     )+  , ( C.PrimCoerce+    , (internalModuleSourceSpan "<Prim.Coerce>", nullImports, primCoerceExports)+    )   , ( C.PrimOrdering     , (internalModuleSourceSpan "<Prim.Ordering>", nullImports, primOrderingExports)     )@@ -399,20 +400,6 @@ exportValueOp ss exps op src = do   valueOps <- addExport ss ValOpName op src (exportedValueOps exps)   return $ exps { exportedValueOps = valueOps }---- |--- Safely adds a kind to some exports, returning an error if a conflict occurs.----exportKind-  :: MonadError MultipleErrors m-  => SourceSpan-  -> Exports-  -> ProperName 'KindName-  -> ExportSource-  -> m Exports-exportKind ss exps name src = do-  kinds <- addExport ss KiName name src (exportedKinds exps)-  return $ exps { exportedKinds = kinds }  -- | -- Adds an entry to a list of exports unless it is already present, in which
src/Language/PureScript/Sugar/Names/Exports.hs view
@@ -59,8 +59,6 @@     exportTypeOp ss exps op source   updateExports exps (ExternDeclaration (ss, _) name _) =     exportValue ss exps name source-  updateExports exps (ExternKindDeclaration (ss, _) pn) =-    exportKind ss exps pn source   updateExports exps _ = return exps  -- |@@ -96,14 +94,12 @@     let classes' = exportedTypeClasses result `M.union` exportedTypeClasses exps     let values' = exportedValues result `M.union` exportedValues exps     let valueOps' = exportedValueOps result `M.union` exportedValueOps exps-    let kinds' = exportedKinds result `M.union` exportedKinds exps     return result       { exportedTypes = types'       , exportedTypeOps = typeOps'       , exportedTypeClasses = classes'       , exportedValues = values'       , exportedValueOps = valueOps'-      , exportedKinds = kinds'       }   elaborateModuleExports result (ModuleRef ss' name) = do     let isPseudo = isPseudoModule name@@ -115,13 +111,11 @@     reClasses <- extract ss' isPseudo name TyClassName (importedTypeClasses imps)     reValues <- extract ss' isPseudo name IdentName (importedValues imps)     reValueOps <- extract ss' isPseudo name ValOpName (importedValueOps imps)-    reKinds <- extract ss' isPseudo name KiName (importedKinds imps)     foldM (\exps' ((tctor, dctors), src) -> exportType ss' ReExport exps' tctor dctors src) result (resolveTypeExports reTypes reDctors)       >>= flip (foldM (uncurry . exportTypeOp ss')) (map resolveTypeOp reTypeOps)       >>= flip (foldM (uncurry . exportTypeClass ss' ReExport)) (map resolveClass reClasses)       >>= flip (foldM (uncurry . exportValue ss')) (map resolveValue reValues)       >>= flip (foldM (uncurry . exportValueOp ss')) (map resolveValueOp reValueOps)-      >>= flip (foldM (uncurry . exportKind ss')) (map resolveKind reKinds)   elaborateModuleExports result _ = return result    -- Extracts a list of values for a module based on a lookup table. If the@@ -215,13 +209,6 @@     = fromMaybe (internalError "Missing value in resolveValueOp")     $ resolve exportedValueOps op -  -- Looks up an imported kind and re-qualifies it with the original-  -- module it came from.-  resolveKind :: Qualified (ProperName 'KindName) -> (ProperName 'KindName, ExportSource)-  resolveKind kind-    = fromMaybe (internalError "Missing value in resolveKind")-    $ resolve exportedKinds kind-   resolve     :: Ord a     => (Exports -> M.Map a ExportSource)@@ -250,14 +237,12 @@   classes <- foldM (filterExport TyClassName getTypeClassRef exportedTypeClasses) M.empty refs   values <- foldM (filterExport IdentName getValueRef exportedValues) M.empty refs   valueOps <- foldM (filterExport ValOpName getValueOpRef exportedValueOps) M.empty refs-  kinds <- foldM (filterExport KiName getKindRef exportedKinds) M.empty refs   return Exports     { exportedTypes = types     , exportedTypeOps = typeOps     , exportedTypeClasses = classes     , exportedValues = values     , exportedValueOps = valueOps-    , exportedKinds = kinds     }    where
src/Language/PureScript/Sugar/Names/Imports.hs view
@@ -123,8 +123,6 @@       checkImportExists ss TyClassName (exportedTypeClasses exps) name     check (ModuleRef ss name) | isHiding =       throwError . errorMessage' ss $ ImportHidingModule name-    check (KindRef ss name) =-      checkImportExists ss KiName (exportedKinds exps) name     check r = internalError $ "Invalid argument to checkRefs: " ++ show r    -- Check that an explicitly imported item exists in the module it is being imported from@@ -176,7 +174,6 @@       >>= flip (foldM (\m (name, _) -> importer m (ValueRef ss name))) (M.toList (exportedValues exps))       >>= flip (foldM (\m (name, _) -> importer m (ValueOpRef ss name))) (M.toList (exportedValueOps exps))       >>= flip (foldM (\m (name, _) -> importer m (TypeClassRef ss name))) (M.toList (exportedTypeClasses exps))-      >>= flip (foldM (\m (name, _) -> importer m (KindRef ss name))) (M.toList (exportedKinds exps))    importRef :: ImportProvenance -> Imports -> DeclarationRef -> m Imports   importRef prov imp (ValueRef ss name) = do@@ -199,9 +196,6 @@   importRef prov imp (TypeClassRef ss name) = do     let typeClasses' = updateImports (importedTypeClasses imp) (exportedTypeClasses exps) id name ss prov     return $ imp { importedTypeClasses = typeClasses' }-  importRef prov imp (KindRef ss name) = do-    let kinds' = updateImports (importedKinds imp) (exportedKinds exps) id name ss prov-    return $ imp { importedKinds = kinds' }   importRef _ _ TypeInstanceRef{} = internalError "TypeInstanceRef in importRef"   importRef _ _ ModuleRef{} = internalError "ModuleRef in importRef"   importRef _ _ ReExportRef{} = internalError "ReExportRef in importRef"
src/Language/PureScript/Sugar/Operators.hs view
@@ -34,10 +34,9 @@ import Data.Functor.Identity (Identity(..), runIdentity) import Data.List (groupBy, sortBy) import Data.Maybe (mapMaybe, listToMaybe)-import Data.Traversable (for) import qualified Data.Map as M -import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C  -- | -- Removes unary negation operators and replaces them with calls to `negate`.@@ -67,8 +66,8 @@   :: forall m    . MonadError MultipleErrors m   => [ExternsFile]-  -> [Module]-  -> m [Module]+  -> Module+  -> m Module rebracket =   rebracketFiltered (const True) @@ -84,13 +83,13 @@    . MonadError MultipleErrors m   => (Declaration -> Bool)   -> [ExternsFile]-  -> [Module]-  -> m [Module]-rebracketFiltered pred_ externs modules = do+  -> Module+  -> m Module+rebracketFiltered pred_ externs m = do   let (valueFixities, typeFixities) =         partitionEithers           $ concatMap externsFixities externs-          ++ concatMap collectFixities modules+          ++ collectFixities m    ensureNoDuplicates' MultipleValueOpFixities valueFixities   ensureNoDuplicates' MultipleTypeOpFixities typeFixities@@ -100,9 +99,8 @@   let typeOpTable = customOperatorTable' typeFixities   let typeAliased = M.fromList (map makeLookupEntry typeFixities) -  for modules-    $ renameAliasedOperators valueAliased typeAliased-    <=< rebracketModule pred_ valueOpTable typeOpTable+  rebracketModule pred_ valueOpTable typeOpTable m >>=+    renameAliasedOperators valueAliased typeAliased    where @@ -167,10 +165,10 @@     goBinder pos other = return (pos, other)      goType :: SourceSpan -> SourceType -> m SourceType-    goType pos (BinaryNoParensType ann (TypeOp ann2 op) lhs rhs) =+    goType pos (TypeOp ann2 op) =       case op `M.lookup` typeAliased of         Just alias ->-          return $ TypeApp ann (TypeApp ann (TypeConstructor ann2 alias) lhs) rhs+          return $ TypeConstructor ann2 alias         Nothing ->           throwError . errorMessage' pos $ UnknownName $ fmap TyOpName op     goType _ other = return other@@ -335,9 +333,10 @@    goExpr :: SourceSpan -> Expr -> m (SourceSpan, Expr)   goExpr _ e@(PositionedValue pos _ _) = return (pos, e)-  goExpr pos (TypeClassDictionary (Constraint ann name tys info) dicts hints) = do+  goExpr pos (TypeClassDictionary (Constraint ann name kinds tys info) dicts hints) = do+    kinds' <- traverse (goType' pos) kinds     tys' <- traverse (goType' pos) tys-    return (pos, TypeClassDictionary (Constraint ann name tys' info) dicts hints)+    return (pos, TypeClassDictionary (Constraint ann name kinds' tys' info) dicts hints)   goExpr pos (DeferredDictionary cls tys) = do     tys' <- traverse (goType' pos) tys     return (pos, DeferredDictionary cls tys')@@ -382,7 +381,7 @@       Right ctor ->         unless (anyTypeRef (maybe False (elem ctor) . snd))           . throwError . errorMessage' ss-          $ TransitiveDctorExportError dr ctor+          $ TransitiveDctorExportError dr [ctor]   checkRef dr@(TypeOpRef ss' op) =     for_ (getTypeOpAlias op) $ \ty ->       unless (anyTypeRef ((== ty) . fst))
src/Language/PureScript/Sugar/Operators/Types.hs view
@@ -31,4 +31,4 @@   fromOp _ = Nothing    reapply :: a -> Qualified (OpName 'TypeOpName) -> SourceType -> SourceType -> SourceType-  reapply _ = srcBinaryNoParensType . srcTypeOp+  reapply _ op t1 t2 = srcTypeApp (srcTypeApp (TypeOp (ss, []) op) t1) t2
src/Language/PureScript/Sugar/TypeClasses.hs view
@@ -21,18 +21,19 @@ import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S import           Data.Text (Text)-import qualified Language.PureScript.Constants as C+import           Data.Traversable (for)+import qualified Language.PureScript.Constants.Prim as C import           Language.PureScript.Crash import           Language.PureScript.Environment import           Language.PureScript.Errors hiding (isExported) import           Language.PureScript.Externs-import           Language.PureScript.Kinds import           Language.PureScript.Label (Label(..)) import           Language.PureScript.Names import           Language.PureScript.PSString (mkString) import           Language.PureScript.Sugar.CaseDeclarations-import           Language.PureScript.Types+import           Language.PureScript.TypeChecker.Synonyms (SynonymMap, KindMap, replaceAllTypeSynonymsM) import           Language.PureScript.TypeClassDictionaries (superclassName)+import           Language.PureScript.Types  type MemberMap = M.Map (ModuleName, ProperName 'ClassName) TypeClassData @@ -45,14 +46,17 @@ desugarTypeClasses   :: (MonadSupply m, MonadError MultipleErrors m)   => [ExternsFile]-  -> [Module]-  -> m [Module]-desugarTypeClasses externs = flip evalStateT initialState . traverse desugarModule+  -> SynonymMap+  -> KindMap+  -> Module+  -> m Module+desugarTypeClasses externs syns kinds = flip evalStateT initialState . desugarModule syns kinds   where   initialState :: MemberMap   initialState =     mconcat       [ M.mapKeys (qualify C.Prim) primClasses+      , M.mapKeys (qualify C.PrimCoerce) primCoerceClasses       , M.mapKeys (qualify C.PrimRow) primRowClasses       , M.mapKeys (qualify C.PrimRowList) primRowListClasses       , M.mapKeys (qualify C.PrimSymbol) primSymbolClasses@@ -70,13 +74,15 @@  desugarModule   :: (MonadSupply m, MonadError MultipleErrors m)-  => Module+  => SynonymMap+  -> KindMap+  -> Module   -> Desugar m Module-desugarModule (Module ss coms name decls (Just exps)) = do-  let (classDecls, restDecls) = partition isTypeClassDeclaration decls+desugarModule syns kinds (Module ss coms name decls (Just exps)) = do+  let (classDecls, restDecls) = partition isTypeClassDecl decls       classVerts = fmap (\d -> (d, classDeclName d, superClassesNames d)) classDecls   (classNewExpss, classDeclss) <- unzip <$> parU (stronglyConnComp classVerts) (desugarClassDecl name exps)-  (restNewExpss, restDeclss) <- unzip <$> parU restDecls (desugarDecl name exps)+  (restNewExpss, restDeclss) <- unzip <$> parU restDecls (desugarDecl syns kinds name exps)   return $ Module ss coms name (concat restDeclss ++ concat classDeclss) $ Just (exps ++ catMaybes restNewExpss ++ catMaybes classNewExpss)   where   desugarClassDecl :: (MonadSupply m, MonadError MultipleErrors m)@@ -84,7 +90,7 @@     -> [DeclarationRef]     -> SCC Declaration     -> Desugar m (Maybe DeclarationRef, [Declaration])-  desugarClassDecl name' exps' (AcyclicSCC d) = desugarDecl name' exps' d+  desugarClassDecl name' exps' (AcyclicSCC d) = desugarDecl syns kinds name' exps' d   desugarClassDecl _ _ (CyclicSCC ds') = throwError . errorMessage' (declSourceSpan (head ds')) $ CycleInTypeClassDeclaration (map classDeclName ds')    superClassesNames :: Declaration -> [Qualified (ProperName 'ClassName)]@@ -92,13 +98,13 @@   superClassesNames _ = []    constraintName :: SourceConstraint -> Qualified (ProperName 'ClassName)-  constraintName (Constraint _ cName _ _) = cName+  constraintName (Constraint _ cName _ _ _) = cName    classDeclName :: Declaration -> Qualified (ProperName 'ClassName)   classDeclName (TypeClassDeclaration _ pn _ _ _ _) = Qualified (Just name) pn   classDeclName _ = internalError "Expected TypeClassDeclaration" -desugarModule _ = internalError "Exports should have been elaborated in name desugaring"+desugarModule _ _ _ = internalError "Exports should have been elaborated in name desugaring"  {- Desugar type class and type class instance declarations --@@ -196,22 +202,27 @@ -} desugarDecl   :: (MonadSupply m, MonadError MultipleErrors m)-  => ModuleName+  => SynonymMap+  -> KindMap+  -> ModuleName   -> [DeclarationRef]   -> Declaration   -> Desugar m (Maybe DeclarationRef, [Declaration])-desugarDecl mn exps = go+desugarDecl syns kinds mn exps = go   where   go d@(TypeClassDeclaration sa name args implies deps members) = do     modify (M.insert (mn, name) (makeTypeClassData args (map memberToNameAndType members) implies deps False))     return (Nothing, d : typeClassDictionaryDeclaration sa name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)   go (TypeInstanceDeclaration _ _ _ _ _ _ _ DerivedInstance) = internalError "Derived instanced should have been desugared"-  go d@(TypeInstanceDeclaration sa _ _ name deps className tys (ExplicitInstance members)) = do+  go d@(TypeInstanceDeclaration sa _ _ name deps className tys (ExplicitInstance members))+    | className == C.Coercible+    = throwError . errorMessage' (fst sa) $ InvalidCoercibleInstanceDeclaration tys+    | otherwise = do     desugared <- desugarCases members-    dictDecl <- typeInstanceDictionaryDeclaration sa name mn deps className tys desugared+    dictDecl <- typeInstanceDictionaryDeclaration syns kinds sa name mn deps className tys desugared     return (expRef name className tys, [d, dictDecl])   go d@(TypeInstanceDeclaration sa _ _ name deps className tys (NewtypeInstanceWithDictionary dict)) = do-    let dictTy = foldl srcTypeApp (srcTypeConstructor (fmap coerceProperName className)) tys+    let dictTy = foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictSynonymName) className)) tys         constrainedTy = quantify (foldr (srcConstrainedType) dictTy deps)     return (expRef name className tys, [d, ValueDecl sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]])   go other = return (Nothing, [other])@@ -254,24 +265,24 @@ typeClassDictionaryDeclaration   :: SourceAnn   -> ProperName 'ClassName-  -> [(Text, Maybe SourceKind)]+  -> [(Text, Maybe SourceType)]   -> [SourceConstraint]   -> [Declaration]   -> Declaration typeClassDictionaryDeclaration sa name args implies members =   let superclassTypes = superClassDictionaryNames implies `zip`-        [ function unit (foldl srcTypeApp (srcTypeConstructor (fmap coerceProperName superclass)) tyArgs)-        | (Constraint _ superclass tyArgs _) <- implies+        [ function unit (foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictSynonymName) superclass)) tyArgs)+        | (Constraint _ superclass _ tyArgs _) <- implies         ]       members' = map (first runIdent . memberToNameAndType) members       mtys = members' ++ superclassTypes       toRowListItem (l, t) = srcRowListItem (Label $ mkString l) t-  in TypeSynonymDeclaration sa (coerceProperName name) args (srcTypeApp tyRecord $ rowFromList (map toRowListItem mtys, srcREmpty))+  in TypeSynonymDeclaration sa (coerceProperName $ dictSynonymName name) args (srcTypeApp tyRecord $ rowFromList (map toRowListItem mtys, srcREmpty))  typeClassMemberToDictionaryAccessor   :: ModuleName   -> ProperName 'ClassName-  -> [(Text, Maybe SourceKind)]+  -> [(Text, Maybe SourceType)]   -> Declaration   -> Declaration typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration (TypeDeclarationData sa ident ty)) =@@ -279,7 +290,7 @@   in ValueDecl sa ident Private [] $     [MkUnguarded (      TypedValue False (TypeClassDictionaryAccessor className ident) $-       moveQuantifiersToFront (quantify (srcConstrainedType (srcConstraint className (map (srcTypeVar . fst) args) Nothing) ty))+       moveQuantifiersToFront (quantify (srcConstrainedType (srcConstraint className [] (map (srcTypeVar . fst) args) Nothing) ty))     )] typeClassMemberToDictionaryAccessor _ _ _ _ = internalError "Invalid declaration in type class definition" @@ -289,7 +300,9 @@ typeInstanceDictionaryDeclaration   :: forall m    . (MonadSupply m, MonadError MultipleErrors m)-  => SourceAnn+  => SynonymMap+  -> KindMap+  -> SourceAnn   -> Ident   -> ModuleName   -> [SourceConstraint]@@ -297,7 +310,7 @@   -> [SourceType]   -> [Declaration]   -> Desugar m Declaration-typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls =+typeInstanceDictionaryDeclaration syns kinds sa@(ss, _) name mn deps className tys decls =   rethrow (addHint (ErrorInInstance className tys)) $ do   m <- get @@ -320,14 +333,15 @@       -- Create the type of the dictionary       -- The type is a record type, but depending on type instance dependencies, may be constrained.       -- The dictionary itself is a record literal.-      let superclasses = superClassDictionaryNames typeClassSuperclasses `zip`-            [ Abs (VarBinder ss UnusedIdent) (DeferredDictionary superclass tyArgs)-            | (Constraint _ superclass suTyArgs _) <- typeClassSuperclasses-            , let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs-            ]+      tys' <- traverse (replaceAllTypeSynonymsM syns kinds) tys+      superclassesDicts <- for typeClassSuperclasses $ \(Constraint _ superclass _ suTyArgs _) -> do+        suTyArgs' <- traverse (replaceAllTypeSynonymsM syns kinds) suTyArgs+        let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys')) suTyArgs'+        pure $ Abs (VarBinder ss UnusedIdent) (DeferredDictionary superclass tyArgs)+      let superclasses = superClassDictionaryNames typeClassSuperclasses `zip` superclassesDicts        let props = Literal ss $ ObjectLiteral $ map (first mkString) (members ++ superclasses)-          dictTy = foldl srcTypeApp (srcTypeConstructor (fmap coerceProperName className)) tys+          dictTy = foldl srcTypeApp (srcTypeConstructor (fmap (coerceProperName . dictSynonymName) className)) tys           constrainedTy = quantify (foldr srcConstrainedType dictTy deps)           dict = TypeClassDictionaryConstructorApp className props           result = ValueDecl sa name Private [] [MkUnguarded (TypedValue True dict constrainedTy)]@@ -352,5 +366,5 @@ superClassDictionaryNames :: [Constraint a] -> [Text] superClassDictionaryNames supers =   [ superclassName pn index-  | (index, Constraint _ pn _ _) <- zip [0..] supers+  | (index, Constraint _ pn _ _ _) <- zip [0..] supers   ]
src/Language/PureScript/Sugar/TypeClasses/Deriving.hs view
@@ -12,23 +12,25 @@ import           Data.Foldable (for_) import           Data.List (foldl', find, sortBy, unzip5) import qualified Data.Map as M-import           Data.Maybe (fromMaybe, mapMaybe)+import           Data.Maybe (fromMaybe) import           Data.Ord (comparing) import qualified Data.Set as S import           Data.Text (Text) import           Language.PureScript.AST-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Data.Generic.Rep as DataGenericRep+import qualified Language.PureScript.Constants.Data.Newtype as DataNewtype+import qualified Language.PureScript.Constants.Prelude as Prelude+import qualified Language.PureScript.Constants.Prim as Prim import           Language.PureScript.Crash import           Language.PureScript.Environment import           Language.PureScript.Errors import           Language.PureScript.Externs-import           Language.PureScript.Kinds import           Language.PureScript.Names import           Language.PureScript.Label (Label(..)) import           Language.PureScript.PSString (mkString) import           Language.PureScript.Types import           Language.PureScript.TypeChecker (checkNewtype)-import           Language.PureScript.TypeChecker.Synonyms (SynonymMap, replaceAllTypeSynonymsM)+import           Language.PureScript.TypeChecker.Synonyms (SynonymMap, KindMap, replaceAllTypeSynonymsM)  -- | When deriving an instance for a newtype, we must ensure that all superclass -- instances were derived in the same way. This data structure is used to ensure@@ -69,25 +71,13 @@   :: forall m    . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => [ExternsFile]+  -> SynonymMap+  -> KindMap   -> Module   -> m Module-deriveInstances externs (Module ss coms mn ds exts) =-    Module ss coms mn <$> mapM (deriveInstance mn synonyms instanceData ds) ds <*> pure exts+deriveInstances externs syns kinds (Module ss coms mn ds exts) =+    Module ss coms mn <$> mapM (deriveInstance mn syns kinds instanceData ds) ds <*> pure exts   where-    -- We need to collect type synonym information, since synonyms will not be-    -- removed until later, during type checking.-    synonyms :: SynonymMap-    synonyms =-        M.fromList $ (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)-                  ++ mapMaybe fromLocalDecl ds-      where-        fromExternsDecl mn' (EDTypeSynonym name args ty) = Just (Qualified (Just mn') name, (args, ty))-        fromExternsDecl _ _ = Nothing--        fromLocalDecl (TypeSynonymDeclaration _ name args ty) =-          Just (Qualified (Just mn) name, (args, ty))-        fromLocalDecl _ = Nothing-     instanceData :: NewtypeDerivedInstances     instanceData =         foldMap (\ExternsFile{..} -> foldMap (fromExternsDecl efModuleName) efDeclarations) externs <> foldMap fromLocalDecl ds@@ -110,16 +100,17 @@   :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => ModuleName   -> SynonymMap+  -> KindMap   -> NewtypeDerivedInstances   -> [Declaration]   -> Declaration   -> m Declaration-deriveInstance mn syns _ ds (TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys DerivedInstance)+deriveInstance mn syns kinds _ ds (TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys DerivedInstance)   | className == Qualified (Just dataEq) (ProperName "Eq")   = case tys of       [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveEq ss mn syns ds tyCon+           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveEq ss mn syns kinds ds tyCon            | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty       _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1   | className == Qualified (Just dataEq) (ProperName "Eq1")@@ -133,7 +124,7 @@   = case tys of       [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveOrd ss mn syns ds tyCon+           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveOrd ss mn syns kinds ds tyCon            | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty       _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1   | className == Qualified (Just dataOrd) (ProperName "Ord1")@@ -147,36 +138,36 @@   = case tys of       [ty] | Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty            , mn == fromMaybe mn mn'-           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveFunctor ss mn syns ds tyCon+           -> TypeInstanceDeclaration sa ch idx nm deps className tys . ExplicitInstance <$> deriveFunctor ss mn syns kinds ds tyCon            | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys ty       _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 1-  | className == Qualified (Just dataNewtype) (ProperName "Newtype")+  | className == DataNewtype.Newtype   = case tys of       [wrappedTy, unwrappedTy]         | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy         , mn == fromMaybe mn mn'-        -> do (inst, actualUnwrappedTy) <- deriveNewtype ss mn syns ds tyCon args unwrappedTy-              return $ TypeInstanceDeclaration sa ch idx nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)+        -> do actualUnwrappedTy <- deriveNewtype ss syns kinds ds tyCon args unwrappedTy+              return $ TypeInstanceDeclaration sa ch idx nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance [])         | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys wrappedTy       _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2-  | className == Qualified (Just dataGenericRep) (ProperName C.generic)+  | className == DataGenericRep.Generic   = case tys of       [actualTy, repTy]         | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor actualTy         , mn == fromMaybe mn mn'-        -> do (inst, inferredRepTy) <- deriveGenericRep ss mn syns ds tyCon args repTy+        -> do (inst, inferredRepTy) <- deriveGenericRep ss mn syns kinds ds tyCon args repTy               return $ TypeInstanceDeclaration sa ch idx nm deps className [actualTy, inferredRepTy] (ExplicitInstance inst)         | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys actualTy       _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2   | otherwise = throwError . errorMessage' ss $ CannotDerive className tys-deriveInstance mn syns ndis ds (TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys NewtypeInstance) =+deriveInstance mn syns kinds ndis ds (TypeInstanceDeclaration sa@(ss, _) ch idx nm deps className tys NewtypeInstance) =   case tys of     _ : _ | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)           , mn == fromMaybe mn mn'-          -> TypeInstanceDeclaration sa ch idx nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance ss mn syns ndis className ds tys tyCon args+          -> TypeInstanceDeclaration sa ch idx nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance ss mn syns kinds ndis className ds tys tyCon args           | otherwise -> throwError . errorMessage' ss $ ExpectedTypeConstructor className tys (last tys)     _ -> throwError . errorMessage' ss $ InvalidNewtypeInstance className tys-deriveInstance _ _ _ _ e = return e+deriveInstance _ _ _ _ _ e = return e  unwrapTypeConstructor :: SourceType -> Maybe (Qualified (ProperName 'TypeName), [SourceType]) unwrapTypeConstructor = fmap (second reverse) . go@@ -193,6 +184,7 @@   => SourceSpan   -> ModuleName   -> SynonymMap+  -> KindMap   -> NewtypeDerivedInstances   -> Qualified (ProperName 'ClassName)   -> [Declaration]@@ -200,7 +192,7 @@   -> ProperName 'TypeName   -> [SourceType]   -> m Expr-deriveNewtypeInstance ss mn syns ndis className ds tys tyConNm dargs = do+deriveNewtypeInstance ss mn syns kinds ndis className ds tys tyConNm dargs = do     verifySuperclasses     tyCon <- findTypeDecl ss tyConNm ds     go tyCon@@ -215,11 +207,13 @@       --       -- since Array a is a type application which uses the last       -- type argument-      wrapped' <- replaceAllTypeSynonymsM syns wrapped+      wrapped' <- replaceAllTypeSynonymsM syns kinds wrapped       case stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped' of         Just wrapped'' -> do           let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs-          return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped'']))+          wrapped''' <- replaceAllTypeSynonymsM syns kinds $ replaceAllTypeVars subst wrapped''+          tys' <- mapM (replaceAllTypeSynonymsM syns kinds) tys+          return (DeferredDictionary className (init tys' ++ [wrapped''']))         Nothing -> throwError . errorMessage' ss $ InvalidNewtypeInstance className tys     go _ = throwError . errorMessage' ss $ InvalidNewtypeInstance className tys @@ -257,18 +251,12 @@                       tell . errorMessage' ss $ MissingNewtypeSuperclassInstance constraintClass className tys                 else tell . errorMessage' ss $ UnverifiableSuperclassInstance constraintClass className tys -dataGenericRep :: ModuleName-dataGenericRep = ModuleName "Data.Generic.Rep"- dataEq :: ModuleName dataEq = ModuleName "Data.Eq"  dataOrd :: ModuleName dataOrd = ModuleName "Data.Ord" -dataNewtype :: ModuleName-dataNewtype = ModuleName "Data.Newtype"- dataFunctor :: ModuleName dataFunctor = ModuleName "Data.Functor" @@ -281,12 +269,13 @@   => SourceSpan   -> ModuleName   -> SynonymMap+  -> KindMap   -> [Declaration]   -> ProperName 'TypeName   -> [SourceType]   -> SourceType   -> m ([Declaration], SourceType)-deriveGenericRep ss mn syns ds tyConNm tyConArgs repTy = do+deriveGenericRep ss mn syns kinds ds tyConNm tyConArgs repTy = do     checkIsWildcard ss tyConNm repTy     go =<< findTypeDecl ss tyConNm ds   where@@ -301,13 +290,13 @@                       lamCase ss' x                         [ CaseAlternative                             [NullBinder]-                            (unguarded (App toName (Var ss' (Qualified Nothing x))))+                            (unguarded (App (Var ss DataGenericRep.to) (Var ss' (Qualified Nothing x))))                         ]                    , ValueDecl (ss', []) (Ident "from") Public [] $ unguarded $                       lamCase ss' x                         [ CaseAlternative                             [NullBinder]-                            (unguarded (App fromName (Var ss' (Qualified Nothing x))))+                            (unguarded (App (Var ss DataGenericRep.from) (Var ss' (Qualified Nothing x))))                         ]                    ]                | otherwise =@@ -327,10 +316,12 @@     select l r n = take (n - 1) (iterate (r .) l) ++ [compN (n - 1) r]      sumBinders :: Int -> [Binder -> Binder]-    sumBinders = select (ConstructorBinder ss inl . pure) (ConstructorBinder ss inr . pure)+    sumBinders = select (ConstructorBinder ss DataGenericRep.Inl . pure)+                        (ConstructorBinder ss DataGenericRep.Inr . pure)      sumExprs :: Int -> [Expr -> Expr]-    sumExprs = select (App (Constructor ss inl)) (App (Constructor ss inr))+    sumExprs = select (App (Constructor ss DataGenericRep.Inl))+                      (App (Constructor ss DataGenericRep.Inr))      compN :: Int -> (a -> a) -> a -> a     compN 0 _ = id@@ -340,39 +331,39 @@       :: DataConstructorDeclaration       -> m (SourceType, CaseAlternative, CaseAlternative)     makeInst (DataConstructorDeclaration _ ctorName args) = do-        args' <- mapM (replaceAllTypeSynonymsM syns . snd) args+        args' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) args         (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'-        return ( srcTypeApp (srcTypeApp (srcTypeConstructor constructor)+        return ( srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Constructor)                                   (srcTypeLevelString $ mkString (runProperName ctorName)))                          ctorTy-               , CaseAlternative [ ConstructorBinder ss constructor [matchProduct] ]+               , CaseAlternative [ ConstructorBinder ss DataGenericRep.Constructor [matchProduct] ]                                  (unguarded (foldl' App (Constructor ss (Qualified (Just mn) ctorName)) ctorArgs))                , CaseAlternative [ ConstructorBinder ss (Qualified (Just mn) ctorName) matchCtor ]-                                 (unguarded (constructor' mkProduct))+                                 (unguarded (App (Constructor ss DataGenericRep.Constructor) mkProduct))                )      makeProduct       :: [SourceType]       -> m (SourceType, Binder, [Expr], [Binder], Expr)     makeProduct [] =-      pure (noArgs, NullBinder, [], [], noArgs')+      pure (srcTypeConstructor DataGenericRep.NoArguments, NullBinder, [], [], Constructor ss DataGenericRep.NoArguments)     makeProduct args = do       (tys, bs1, es1, bs2, es2) <- unzip5 <$> traverse makeArg args-      pure ( foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor productName) f)) tys-           , foldr1 (\b1 b2 -> ConstructorBinder ss productName [b1, b2]) bs1+      pure ( foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Product) f)) tys+           , foldr1 (\b1 b2 -> ConstructorBinder ss DataGenericRep.Product [b1, b2]) bs1            , es1            , bs2-           , foldr1 (\e1 -> App (App (Constructor ss productName) e1)) es2+           , foldr1 (\e1 -> App (App (Constructor ss DataGenericRep.Product) e1)) es2            )      makeArg :: SourceType -> m (SourceType, Binder, Expr, Binder, Expr)     makeArg arg = do       argName <- freshIdent "arg"-      pure ( srcTypeApp (srcTypeConstructor argument) arg-           , ConstructorBinder ss argument [ VarBinder ss argName ]+      pure ( srcTypeApp (srcTypeConstructor DataGenericRep.Argument) arg+           , ConstructorBinder ss DataGenericRep.Argument [ VarBinder ss argName ]            , Var ss (Qualified Nothing argName)            , VarBinder ss argName-           , argument' (Var ss (Qualified Nothing argName))+           , App (Constructor ss DataGenericRep.Argument) (Var ss (Qualified Nothing argName))            )      underBinder :: (Binder -> Binder) -> CaseAlternative -> CaseAlternative@@ -383,48 +374,9 @@     underExpr _ _ = internalError "underExpr: expected unguarded alternative"      toRepTy :: [SourceType] -> SourceType-    toRepTy [] = noCtors+    toRepTy [] = srcTypeConstructor DataGenericRep.NoConstructors     toRepTy [only] = only-    toRepTy ctors = foldr1 (\f -> srcTypeApp (srcTypeApp sumCtor f)) ctors--    toName :: Expr-    toName = Var ss (Qualified (Just dataGenericRep) (Ident "to"))--    fromName :: Expr-    fromName = Var ss (Qualified (Just dataGenericRep) (Ident "from"))--    noCtors :: SourceType-    noCtors = srcTypeConstructor (Qualified (Just dataGenericRep) (ProperName "NoConstructors"))--    noArgs :: SourceType-    noArgs = srcTypeConstructor (Qualified (Just dataGenericRep) (ProperName "NoArguments"))--    noArgs' :: Expr-    noArgs' = Constructor ss (Qualified (Just dataGenericRep) (ProperName "NoArguments"))--    sumCtor :: SourceType-    sumCtor = srcTypeConstructor (Qualified (Just dataGenericRep) (ProperName "Sum"))--    inl :: Qualified (ProperName 'ConstructorName)-    inl = Qualified (Just dataGenericRep) (ProperName "Inl")--    inr :: Qualified (ProperName 'ConstructorName)-    inr = Qualified (Just dataGenericRep) (ProperName "Inr")--    productName :: Qualified (ProperName ty)-    productName = Qualified (Just dataGenericRep) (ProperName "Product")--    constructor :: Qualified (ProperName ty)-    constructor = Qualified (Just dataGenericRep) (ProperName "Constructor")--    constructor' :: Expr -> Expr-    constructor' = App (Constructor ss constructor)--    argument :: Qualified (ProperName ty)-    argument = Qualified (Just dataGenericRep) (ProperName "Argument")--    argument' :: Expr -> Expr-    argument' = App (Constructor ss argument)+    toRepTy ctors = foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Sum) f)) ctors  checkIsWildcard :: MonadError MultipleErrors m => SourceSpan -> ProperName 'TypeName -> SourceType -> m () checkIsWildcard _ _ (TypeWildcard _ Nothing) = return ()@@ -437,13 +389,14 @@   => SourceSpan   -> ModuleName   -> SynonymMap+  -> KindMap   -> [Declaration]   -> ProperName 'TypeName   -> m [Declaration]-deriveEq ss mn syns ds tyConNm = do+deriveEq ss mn syns kinds ds tyConNm = do   tyCon <- findTypeDecl ss tyConNm ds   eqFun <- mkEqFunction tyCon-  return [ ValueDecl (ss, []) (Ident C.eq) Public [] (unguarded eqFun) ]+  return [ ValueDecl (ss, []) (Ident Prelude.eq) Public [] (unguarded eqFun) ]   where     mkEqFunction :: Declaration -> m Expr     mkEqFunction (DataDeclaration (ss', _) _ _ _ args) = do@@ -453,13 +406,13 @@     mkEqFunction _ = internalError "mkEqFunction: expected DataDeclaration"      preludeConj :: Expr -> Expr -> Expr-    preludeConj = App . App (Var ss (Qualified (Just (ModuleName "Data.HeytingAlgebra")) (Ident C.conj)))+    preludeConj = App . App (Var ss (Qualified (Just (ModuleName "Data.HeytingAlgebra")) (Ident Prelude.conj)))      preludeEq :: Expr -> Expr -> Expr-    preludeEq = App . App (Var ss (Qualified (Just dataEq) (Ident C.eq)))+    preludeEq = App . App (Var ss (Qualified (Just dataEq) (Ident Prelude.eq)))      preludeEq1 :: Expr -> Expr -> Expr-    preludeEq1 = App . App (Var ss (Qualified (Just dataEq) (Ident C.eq1)))+    preludeEq1 = App . App (Var ss (Qualified (Just dataEq) (Ident Prelude.eq1)))      addCatch :: [CaseAlternative] -> [CaseAlternative]     addCatch xs@@ -472,7 +425,7 @@     mkCtorClause (DataConstructorDeclaration _ ctorName tys) = do       identsL <- replicateM (length tys) (freshIdent "l")       identsR <- replicateM (length tys) (freshIdent "r")-      tys' <- mapM (replaceAllTypeSynonymsM syns . snd) tys+      tys' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) tys       let tests = zipWith3 toEqTest (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'       return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (unguarded (conjAll tests))       where@@ -494,10 +447,10 @@  deriveEq1 :: SourceSpan -> [Declaration] deriveEq1 ss =-  [ ValueDecl (ss, []) (Ident C.eq1) Public [] (unguarded preludeEq)]+  [ ValueDecl (ss, []) (Ident Prelude.eq1) Public [] (unguarded preludeEq)]   where     preludeEq :: Expr-    preludeEq = Var ss (Qualified (Just dataEq) (Ident C.eq))+    preludeEq = Var ss (Qualified (Just dataEq) (Ident Prelude.eq))  deriveOrd   :: forall m@@ -505,13 +458,14 @@   => SourceSpan   -> ModuleName   -> SynonymMap+  -> KindMap   -> [Declaration]   -> ProperName 'TypeName   -> m [Declaration]-deriveOrd ss mn syns ds tyConNm = do+deriveOrd ss mn syns kinds ds tyConNm = do   tyCon <- findTypeDecl ss tyConNm ds   compareFun <- mkCompareFunction tyCon-  return [ ValueDecl (ss, []) (Ident C.compare) Public [] (unguarded compareFun) ]+  return [ ValueDecl (ss, []) (Ident Prelude.compare) Public [] (unguarded compareFun) ]   where     mkCompareFunction :: Declaration -> m Expr     mkCompareFunction (DataDeclaration (ss', _) _ _ _ args) = do@@ -542,16 +496,16 @@     orderingBinder name = ConstructorBinder ss (orderingName name) []      ordCompare :: Expr -> Expr -> Expr-    ordCompare = App . App (Var ss (Qualified (Just dataOrd) (Ident C.compare)))+    ordCompare = App . App (Var ss (Qualified (Just dataOrd) (Ident Prelude.compare)))      ordCompare1 :: Expr -> Expr -> Expr-    ordCompare1 = App . App (Var ss (Qualified (Just dataOrd) (Ident C.compare1)))+    ordCompare1 = App . App (Var ss (Qualified (Just dataOrd) (Ident Prelude.compare1)))      mkCtorClauses :: (DataConstructorDeclaration, Bool) -> m [CaseAlternative]     mkCtorClauses ((DataConstructorDeclaration _ ctorName tys), isLast) = do       identsL <- replicateM (length tys) (freshIdent "l")       identsR <- replicateM (length tys) (freshIdent "r")-      tys' <- mapM (replaceAllTypeSynonymsM syns . snd) tys+      tys' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) tys       let tests = zipWith3 toOrdering (map (Var ss . Qualified Nothing) identsL) (map (Var ss . Qualified Nothing) identsR) tys'           extras | not isLast = [ CaseAlternative [ ConstructorBinder ss (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)                                                   , NullBinder@@ -595,47 +549,35 @@  deriveOrd1 :: SourceSpan -> [Declaration] deriveOrd1 ss =-  [ ValueDecl (ss, []) (Ident C.compare1) Public [] (unguarded dataOrdCompare)]+  [ ValueDecl (ss, []) (Ident Prelude.compare1) Public [] (unguarded dataOrdCompare)]   where     dataOrdCompare :: Expr-    dataOrdCompare = Var ss (Qualified (Just dataOrd) (Ident C.compare))+    dataOrdCompare = Var ss (Qualified (Just dataOrd) (Ident Prelude.compare))  deriveNewtype   :: forall m    . (MonadError MultipleErrors m, MonadSupply m)   => SourceSpan-  -> ModuleName   -> SynonymMap+  -> KindMap   -> [Declaration]   -> ProperName 'TypeName   -> [SourceType]   -> SourceType-  -> m ([Declaration], SourceType)-deriveNewtype ss mn syns ds tyConNm tyConArgs unwrappedTy = do+  -> m SourceType+deriveNewtype ss syns kinds ds tyConNm tyConArgs unwrappedTy = do     checkIsWildcard ss tyConNm unwrappedTy     go =<< findTypeDecl ss tyConNm ds   where-    go :: Declaration -> m ([Declaration], SourceType)+    go :: Declaration -> m SourceType     go (DataDeclaration (ss', _) Data name _ _) =       throwError . errorMessage' ss' $ CannotDeriveNewtypeForData name-    go (DataDeclaration (ss', _) Newtype name args dctors) = do+    go (DataDeclaration _ Newtype name args dctors) = do       checkNewtype name dctors-      wrappedIdent <- freshIdent "n"-      unwrappedIdent <- freshIdent "a"-      let (DataConstructorDeclaration _ ctorName [(_, ty)]) = head dctors-      ty' <- replaceAllTypeSynonymsM syns ty-      let inst =-            [ ValueDecl (ss', []) (Ident "wrap") Public [] $ unguarded $-                Constructor ss' (Qualified (Just mn) ctorName)-            , ValueDecl (ss', []) (Ident "unwrap") Public [] $ unguarded $-                lamCase ss' wrappedIdent-                  [ CaseAlternative-                      [ConstructorBinder ss' (Qualified (Just mn) ctorName) [VarBinder ss' unwrappedIdent]]-                      (unguarded (Var ss' (Qualified Nothing unwrappedIdent)))-                  ]-            ]-          subst = zipWith ((,) . fst) args tyConArgs-      return (inst, replaceAllTypeVars subst ty')+      let (DataConstructorDeclaration _ _ [(_, ty)]) = head dctors+      ty' <- replaceAllTypeSynonymsM syns kinds ty+      let subst = zipWith ((,) . fst) args tyConArgs+      return $ replaceAllTypeVars subst ty'     go _ = internalError "deriveNewtype go: expected DataDeclaration"  findTypeDecl@@ -670,13 +612,13 @@ isAppliedVar _ = False  objectType :: Type a -> Maybe (Type a)-objectType (TypeApp _ (TypeConstructor _ C.Record) rec) = Just rec+objectType (TypeApp _ (TypeConstructor _ Prim.Record) rec) = Just rec objectType _ = Nothing  decomposeRec :: SourceType -> Maybe [(Label, SourceType)] decomposeRec = fmap (sortBy (comparing fst)) . go   where go (RCons _ str typ typs) = fmap ((str, typ) :) (go typs)-        go (REmpty _) = Just []+        go (REmptyKinded _ _) = Just []         go _ = Nothing  decomposeRec' :: SourceType -> [(Label, SourceType)]@@ -690,17 +632,18 @@   => SourceSpan   -> ModuleName   -> SynonymMap+  -> KindMap   -> [Declaration]   -> ProperName 'TypeName   -> m [Declaration]-deriveFunctor ss mn syns ds tyConNm = do+deriveFunctor ss mn syns kinds ds tyConNm = do   tyCon <- findTypeDecl ss tyConNm ds   mapFun <- mkMapFunction tyCon-  return [ ValueDecl (ss, []) (Ident C.map) Public [] (unguarded mapFun) ]+  return [ ValueDecl (ss, []) (Ident Prelude.map) Public [] (unguarded mapFun) ]   where     mkMapFunction :: Declaration -> m Expr     mkMapFunction (DataDeclaration (ss', _) _ _ tys ctors) = case reverse tys of-      [] -> throwError . errorMessage' ss' $ KindsDoNotUnify (FunKind nullSourceAnn kindType kindType) kindType+      [] -> throwError . errorMessage' ss' $ KindsDoNotUnify (kindType -:> kindType) kindType       ((iTy, _) : _) -> do         f <- freshIdent "f"         m <- freshIdent "m"@@ -710,7 +653,7 @@     mkCtorClause :: Text -> Ident -> DataConstructorDeclaration -> m CaseAlternative     mkCtorClause iTyName f (DataConstructorDeclaration _ ctorName ctorTys) = do       idents <- replicateM (length ctorTys) (freshIdent "v")-      ctorTys' <- mapM (replaceAllTypeSynonymsM syns . snd) ctorTys+      ctorTys' <- mapM (replaceAllTypeSynonymsM syns kinds . snd) ctorTys       args <- zipWithM transformArg idents ctorTys'       let ctor = Constructor ss (Qualified (Just mn) ctorName)           rebuilt = foldl' App ctor args@@ -718,7 +661,7 @@       return $ CaseAlternative [caseBinder] (unguarded rebuilt)       where         fVar = mkVar ss f-        mapVar = mkVarMn ss (Just dataFunctor) (Ident C.map)+        mapVar = mkVarMn ss (Just dataFunctor) (Ident Prelude.map)          -- TODO: deal with type synonyms, ala https://github.com/purescript/purescript/pull/2516         transformArg :: Ident -> SourceType -> m Expr
src/Language/PureScript/Sugar/TypeDeclarations.hs view
@@ -8,6 +8,7 @@  import Prelude.Compat +import Control.Monad (unless) import Control.Monad.Error.Class (MonadError(..))  import Language.PureScript.AST@@ -24,7 +25,9 @@   => Module   -> m Module desugarTypeDeclarationsModule (Module modSS coms name ds exps) =-  rethrow (addHint (ErrorInModule name)) $+  rethrow (addHint (ErrorInModule name)) $ do+    checkKindDeclarations ds+    checkRoleDeclarations Nothing ds     Module modSS coms name <$> desugarTypeDeclarations ds <*> pure exps   where @@ -53,3 +56,55 @@         <*> desugarTypeDeclarations rest   desugarTypeDeclarations (d:rest) = (:) d <$> desugarTypeDeclarations rest   desugarTypeDeclarations [] = return []++  checkKindDeclarations :: [Declaration] -> m ()+  checkKindDeclarations (KindDeclaration sa kindFor name' _ : d : rest) = do+    unless (matchesDeclaration d) . throwError . errorMessage' (fst sa) $ OrphanKindDeclaration name'+    checkKindDeclarations rest+    where+    matchesDeclaration :: Declaration -> Bool+    matchesDeclaration (DataDeclaration _ Data name'' _ _) = kindFor == DataSig && name' == name''+    matchesDeclaration (DataDeclaration _ Newtype name'' _ _) = kindFor == NewtypeSig && name' == name''+    matchesDeclaration (TypeSynonymDeclaration _ name'' _ _) = kindFor == TypeSynonymSig && name' == name''+    matchesDeclaration (TypeClassDeclaration _ name'' _ _ _ _) = kindFor == ClassSig && name' == coerceProperName name''+    matchesDeclaration _ = False+  checkKindDeclarations (KindDeclaration sa _ name' _ : _) = do+    throwError . errorMessage' (fst sa) $ OrphanKindDeclaration name'+  checkKindDeclarations (_ : rest) = checkKindDeclarations rest+  checkKindDeclarations [] = return ()++  checkRoleDeclarations :: Maybe Declaration -> [Declaration] -> m ()+  checkRoleDeclarations Nothing (RoleDeclaration RoleDeclarationData{..} : _) =+    throwError . errorMessage' (fst rdeclSourceAnn) $ OrphanRoleDeclaration rdeclIdent+  checkRoleDeclarations (Just (RoleDeclaration (RoleDeclarationData _ name' _))) ((RoleDeclaration (RoleDeclarationData{..})) : _) | name' == rdeclIdent =+    throwError . errorMessage' (fst rdeclSourceAnn) $ DuplicateRoleDeclaration rdeclIdent+  checkRoleDeclarations (Just d) (rd@(RoleDeclaration (RoleDeclarationData{..})) : rest) = do+    unless (matchesDeclaration d) . throwError . errorMessage' (fst rdeclSourceAnn) $ OrphanRoleDeclaration rdeclIdent+    unless (isSupported d) . throwError . errorMessage' (fst rdeclSourceAnn) $ UnsupportedRoleDeclaration+    checkRoleDeclarationArity d+    checkRoleDeclarations (Just rd) rest+    where+    isSupported :: Declaration -> Bool+    isSupported (DataDeclaration{}) = True+    isSupported (ExternDataDeclaration{}) = True+    isSupported _ = False+    matchesDeclaration :: Declaration -> Bool+    matchesDeclaration (DataDeclaration _ _ name' _ _) = rdeclIdent == name'+    matchesDeclaration (ExternDataDeclaration _ name' _) = rdeclIdent == name'+    matchesDeclaration (TypeSynonymDeclaration _ name' _ _) = rdeclIdent == name'+    matchesDeclaration (TypeClassDeclaration _ name' _ _ _ _) = rdeclIdent == coerceProperName name'+    matchesDeclaration _ = False+    checkRoleDeclarationArity :: Declaration -> m ()+    checkRoleDeclarationArity (DataDeclaration _ _ _ args _) =+      throwRoleDeclarationArityMismatch $ length args+    checkRoleDeclarationArity (ExternDataDeclaration _ _ kind) =+      throwRoleDeclarationArityMismatch $ kindArity kind+    checkRoleDeclarationArity _ = return ()+    throwRoleDeclarationArityMismatch :: Int -> m ()+    throwRoleDeclarationArityMismatch expected = do+      let actual = length rdeclRoles+      unless (expected == actual) $+        throwError . errorMessage' (fst rdeclSourceAnn) $+          RoleDeclarationArityMismatch rdeclIdent expected actual+  checkRoleDeclarations _ (d : rest) = checkRoleDeclarations (Just d) rest+  checkRoleDeclarations _ [] = return ()
− src/Language/PureScript/Traversals.hs 
@@ -1,27 +0,0 @@--- | Common functions for implementing generic traversals
-module Language.PureScript.Traversals where
-
-import Prelude.Compat
-
-fstM :: (Functor f) => (a -> f c) -> (a, b) -> f (c, b)
-fstM f (a, b) = flip (,) b <$> f a
-
-sndM :: (Functor f) => (b -> f c) -> (a, b) -> f (a, c)
-sndM f (a, b) = (,) a <$> f b
-
-thirdM :: (Functor f) => (c -> f d) -> (a, b, c) -> f (a, b, d)
-thirdM f (a, b, c) = (,,) a b <$> f c
-
-pairM :: (Applicative f) => (a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
-pairM f g (a, b)  = (,) <$> f a <*> g b
-
-maybeM :: (Applicative f) => (a -> f b) -> Maybe a -> f (Maybe b)
-maybeM _ Nothing = pure Nothing
-maybeM f (Just a) = Just <$> f a
-
-eitherM :: (Applicative f) => (a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
-eitherM f _ (Left a)  = Left  <$> f a
-eitherM _ g (Right b) = Right <$> g b
-
-defS :: (Monad m) => st -> val -> m (st, val)
-defS s val = return (s, val)
src/Language/PureScript/TypeChecker.hs view
@@ -10,9 +10,9 @@   ) where  import Prelude.Compat-import Protolude (ordNub)+import Protolude (headMay, ordNub) -import Control.Monad (when, unless, void, forM)+import Control.Monad (when, unless, void, forM,) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), modify, gets) import Control.Monad.Supply.Class (MonadSupply)@@ -21,6 +21,7 @@ import Data.Foldable (for_, traverse_, toList) import Data.List (nub, nubBy, (\\), sort, group, intersect) import Data.Maybe+import Data.Either (partitionEithers) import Data.Text (Text) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as M@@ -28,69 +29,93 @@ import qualified Data.Text as T  import Language.PureScript.AST+import qualified Language.PureScript.Constants.Data.Generic.Rep as DataGenericRep+import qualified Language.PureScript.Constants.Data.Newtype as DataNewtype import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors-import Language.PureScript.Kinds import Language.PureScript.Linter import Language.PureScript.Names+import Language.PureScript.Roles+import Language.PureScript.Sugar.Names.Env (Exports(..)) import Language.PureScript.TypeChecker.Kinds as T import Language.PureScript.TypeChecker.Monad as T+import Language.PureScript.TypeChecker.Roles as T import Language.PureScript.TypeChecker.Synonyms as T import Language.PureScript.TypeChecker.Types as T+import Language.PureScript.TypeChecker.Unify (varIfUnknown) import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types -import Lens.Micro.Platform ((^..), _2, _3)+import Lens.Micro.Platform ((^..), _2)  addDataType   :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => ModuleName   -> DataDeclType   -> ProperName 'TypeName-  -> [(Text, Maybe SourceKind)]-  -> [DataConstructorDeclaration]-  -> SourceKind+  -> [(Text, Maybe SourceType, Role)]+  -> [(DataConstructorDeclaration, SourceType)]+  -> SourceType   -> m () addDataType moduleName dtype name args dctors ctorKind = do   env <- getEnv   let mapDataCtor (DataConstructorDeclaration _ ctorName vars) = (ctorName, snd <$> vars)-  putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (ctorKind, DataType args (map mapDataCtor dctors)) (types env) }-  for_ dctors $ \(DataConstructorDeclaration _ dctor fields) ->+      qualName = (Qualified (Just moduleName) name)+      hasSig = qualName `M.member` types env+  putEnv $ env { types = M.insert qualName (ctorKind, DataType dtype args (map (mapDataCtor . fst) dctors)) (types env) }+  unless (hasSig || not (containsForAll ctorKind)) $ do+    tell . errorMessage $ MissingKindDeclaration (if dtype == Newtype then NewtypeSig else DataSig) name ctorKind+  for_ dctors $ \(DataConstructorDeclaration _ dctor fields, polyType) ->     warnAndRethrow (addHint (ErrorInDataConstructor dctor)) $-      addDataConstructor moduleName dtype name (map fst args) dctor fields+      addDataConstructor moduleName dtype name dctor fields polyType  addDataConstructor   :: (MonadState CheckState m, MonadError MultipleErrors m)   => ModuleName   -> DataDeclType   -> ProperName 'TypeName-  -> [Text]   -> ProperName 'ConstructorName   -> [(Ident, SourceType)]+  -> SourceType   -> m ()-addDataConstructor moduleName dtype name args dctor dctorArgs = do-  let (fields, tys) = unzip dctorArgs+addDataConstructor moduleName dtype name dctor dctorArgs polyType = do+  let fields = fst <$> dctorArgs   env <- getEnv-  traverse_ checkTypeSynonyms tys-  let retTy = foldl srcTypeApp (srcTypeConstructor (Qualified (Just moduleName) name)) (map srcTypeVar args)-  let dctorTy = foldr function retTy tys-  let polyType = mkForAll (map (\i -> (NullSourceAnn, (i, Nothing))) args) dctorTy+  checkTypeSynonyms polyType   putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (dtype, name, polyType, fields) (dataConstructors env) } -addTypeSynonym+-- | Add an explicit role declaration to the Environment. The idea is that we+-- do this before encountering the data type which it refers to; we don't check+-- that the role declaration is valid until we encounter the data type's own+-- declaration.+addExplicitRoleDeclaration   :: (MonadState CheckState m, MonadError MultipleErrors m)   => ModuleName   -> ProperName 'TypeName-  -> [(Text, Maybe SourceKind)]+  -> [Role]+  -> m ()+addExplicitRoleDeclaration moduleName name roles = do+  env <- getEnv+  putEnv $ env { roleDeclarations = M.insert (Qualified (Just moduleName) name) roles (roleDeclarations env) }++addTypeSynonym+  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => ModuleName+  -> ProperName 'TypeName+  -> [(Text, Maybe SourceType)]   -> SourceType-  -> SourceKind+  -> SourceType   -> m () addTypeSynonym moduleName name args ty kind = do   env <- getEnv   checkTypeSynonyms ty-  putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, TypeSynonym) (types env)-               , typeSynonyms = M.insert (Qualified (Just moduleName) name) (args, ty) (typeSynonyms env) }+  let qualName = (Qualified (Just moduleName) name)+      hasSig = qualName `M.member` types env+  unless (hasSig || isDictSynonym name || not (containsForAll kind)) $ do+    tell . errorMessage $ MissingKindDeclaration TypeSynonymSig name kind+  putEnv $ env { types = M.insert qualName (kind, TypeSynonym) (types env)+               , typeSynonyms = M.insert qualName (args, ty) (typeSynonyms env) }  valueIsNotDefined   :: (MonadState CheckState m, MonadError MultipleErrors m)@@ -116,27 +141,37 @@  addTypeClass   :: forall m-   . (MonadState CheckState m, MonadError MultipleErrors m)-  => Qualified (ProperName 'ClassName)-  -> [(Text, Maybe SourceKind)]+   . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => ModuleName+  -> Qualified (ProperName 'ClassName)+  -> [(Text, Maybe SourceType)]   -> [SourceConstraint]   -> [FunctionalDependency]   -> [Declaration]+  -> SourceType   -> m ()-addTypeClass qualifiedClassName args implies dependencies ds = do+addTypeClass _ qualifiedClassName args implies dependencies ds kind = do   env <- getEnv-  let newClass = mkNewClass env-  traverse_ (checkMemberIsUsable newClass (typeSynonyms env)) classMembers-  modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert qualifiedClassName newClass (typeClasses . checkEnv $ st) } }+  newClass <- mkNewClass+  let qualName = fmap coerceProperName qualifiedClassName+      hasSig = qualName `M.member` types env+  unless (hasSig || not (containsForAll kind)) $ do+    tell . errorMessage $ MissingKindDeclaration ClassSig (disqualify qualName) kind+  traverse_ (checkMemberIsUsable newClass (typeSynonyms env) (types env)) classMembers+  putEnv $ env { types = M.insert qualName (kind, ExternData (nominalRolesForKind kind)) (types env)+               , typeClasses = M.insert qualifiedClassName newClass (typeClasses env) }   where     classMembers :: [(Ident, SourceType)]     classMembers = map toPair ds -    mkNewClass :: Environment -> TypeClassData-    mkNewClass env = makeTypeClassData args classMembers implies dependencies ctIsEmpty+    mkNewClass :: m TypeClassData+    mkNewClass = do+      env <- getEnv+      implies' <- (traverse . overConstraintArgs . traverse) replaceAllTypeSynonyms implies+      let ctIsEmpty = null classMembers && all (typeClassIsEmpty . findSuperClass env) implies'+      pure $ makeTypeClassData args classMembers implies' dependencies ctIsEmpty       where-      ctIsEmpty = null classMembers && all (typeClassIsEmpty . findSuperClass) implies-      findSuperClass c = case M.lookup (constraintClass c) (typeClasses env) of+      findSuperClass env c = case M.lookup (constraintClass c) (typeClasses env) of         Just tcd -> tcd         Nothing -> internalError "Unknown super class in TypeClassDeclaration" @@ -152,9 +187,9 @@     -- Currently we are only checking usability based on the type class currently     -- being defined.  If the mentioned arguments don't include a covering set,     -- then we won't be able to find a instance.-    checkMemberIsUsable :: TypeClassData -> T.SynonymMap -> (Ident, SourceType) -> m ()-    checkMemberIsUsable newClass syns (ident, memberTy) = do-      memberTy' <- T.replaceAllTypeSynonymsM syns memberTy+    checkMemberIsUsable :: TypeClassData -> T.SynonymMap -> T.KindMap -> (Ident, SourceType) -> m ()+    checkMemberIsUsable newClass syns kinds (ident, memberTy) = do+      memberTy' <- T.replaceAllTypeSynonymsM syns kinds memberTy       let mentionedArgIndexes = S.fromList (mapMaybe argToIndex (freeTypeVariables memberTy'))       let leftovers = map (`S.difference` mentionedArgIndexes) (coveringSets newClass) @@ -198,11 +233,10 @@   check = \case     TypeVar _ _ -> return ()     TypeLevelString _ _ -> return ()-    TypeConstructor _ ctor -> do-      env <- getEnv-      when (ctor `M.member` typeSynonyms env) . throwError . errorMessage $ TypeSynonymInstance-      return ()+    TypeConstructor _ _ -> return ()     TypeApp _ t1 t2 -> check t1 >> check t2+    KindApp _ t k -> check t >> check k+    KindedType _ t _ -> check t     REmpty _ | isFunDepDetermined -> return ()     RCons _ _ hd tl | isFunDepDetermined -> check hd >> check tl     ty -> throwError . errorMessage $ InvalidInstanceHead ty@@ -225,6 +259,8 @@ -- --  * Type-check all values and add them to the @Environment@ --+--  * Infer all type roles and add them to the @Environment@+-- --  * Bring type class instances into scope -- --  * Process module imports@@ -243,40 +279,68 @@     warnAndRethrow (addHint (ErrorInTypeConstructor name) . addHint (positionedError ss)) $ do       when (dtype == Newtype) $ checkNewtype name dctors       checkDuplicateTypeArguments $ map fst args-      ctorKind <- kindsOf True moduleName name args (concatMap (fmap snd . dataCtorFields) dctors)+      (dataCtors, ctorKind) <- kindOfData moduleName (sa, name, args, dctors)       let args' = args `withKinds` ctorKind-      addDataType moduleName dtype name args' dctors ctorKind+      env <- getEnv+      dctors' <- traverse (replaceTypeSynonymsInDataConstructor . fst) dataCtors+      roles <- checkRoles env moduleName name args' dctors'+      let args'' = args' `withRoles` roles+      addDataType moduleName dtype name args'' dataCtors ctorKind     return $ DataDeclaration sa dtype name args dctors   go (d@(DataBindingGroupDeclaration tys)) = do     let tysList = NEL.toList tys         syns = mapMaybe toTypeSynonym tysList         dataDecls = mapMaybe toDataDecl tysList-        bindingGroupNames = ordNub ((syns^..traverse._2) ++ (dataDecls^..traverse._3))+        clss = mapMaybe toClassDecl tysList+        bindingGroupNames = ordNub ((syns^..traverse._2) ++ (dataDecls^..traverse._2._2) ++ (fmap coerceProperName (clss^..traverse._2._2)))         sss = fmap declSourceSpan tys     warnAndRethrow (addHint (ErrorInDataBindingGroup bindingGroupNames) . addHint (PositionedError sss)) $ do-      (syn_ks, data_ks) <- kindsOfAll moduleName syns (map (\(sa, _, name, args, dctors) -> (sa, name, args, concatMap (fmap snd . dataCtorFields) dctors)) dataDecls)-      for_ (zip dataDecls data_ks) $ \((_, dtype, name, args, dctors), ctorKind) -> do-        when (dtype == Newtype) $ checkNewtype name dctors-        checkDuplicateTypeArguments $ map fst args-        let args' = args `withKinds` ctorKind-        addDataType moduleName dtype name args' dctors ctorKind-      for_ (zip syns syn_ks) $ \((_, name, args, ty), kind) -> do+      env <- getEnv+      (syn_ks, data_ks, cls_ks) <- kindsOfAll moduleName syns (fmap snd dataDecls) (fmap snd clss)+      for_ (zip syns syn_ks) $ \((_, name, args, _), (elabTy, kind)) -> do         checkDuplicateTypeArguments $ map fst args         let args' = args `withKinds` kind-        addTypeSynonym moduleName name args' ty kind+        addTypeSynonym moduleName name args' elabTy kind+      let dataDeclsWithKinds = zipWith (\(dtype, (_, name, args, _)) (dataCtors, ctorKind) ->+            (dtype, name, args `withKinds` ctorKind, dataCtors, ctorKind)) dataDecls data_ks+      checkRoles' <- fmap (checkDataBindingGroupRoles env moduleName) .+        forM dataDeclsWithKinds $ \(_, name, args, dataCtors, _) ->+          (name, args,) <$> traverse (replaceTypeSynonymsInDataConstructor . fst) dataCtors+      for_ dataDeclsWithKinds $ \(dtype, name, args', dataCtors, ctorKind) -> do+        when (dtype == Newtype) $ checkNewtype name (map fst dataCtors)+        checkDuplicateTypeArguments $ map fst args'+        roles <- checkRoles' name args'+        let args'' = args' `withRoles` roles+        addDataType moduleName dtype name args'' dataCtors ctorKind+      for_ (zip clss cls_ks) $ \((deps, (sa, pn, _, _, _)), (args', implies', tys', kind)) -> do+        let qualifiedClassName = Qualified (Just moduleName) pn+        guardWith (errorMessage (DuplicateTypeClass pn (fst sa))) $+          not (M.member qualifiedClassName (typeClasses env))+        addTypeClass moduleName qualifiedClassName (fmap Just <$> args') implies' deps tys' kind     return d     where     toTypeSynonym (TypeSynonymDeclaration sa nm args ty) = Just (sa, nm, args, ty)     toTypeSynonym _ = Nothing-    toDataDecl (DataDeclaration sa dtype nm args dctors) = Just (sa, dtype, nm, args, dctors)+    toDataDecl (DataDeclaration sa dtype nm args dctors) = Just (dtype, (sa, nm, args, dctors))     toDataDecl _ = Nothing+    toClassDecl (TypeClassDeclaration sa nm args implies deps decls) = Just (deps, (sa, nm, args, implies, decls))+    toClassDecl _ = Nothing   go (TypeSynonymDeclaration sa@(ss, _) name args ty) = do     warnAndRethrow (addHint (ErrorInTypeSynonym name) . addHint (positionedError ss) ) $ do       checkDuplicateTypeArguments $ map fst args-      kind <- kindsOf False moduleName name args [ty]+      (elabTy, kind) <- kindOfTypeSynonym moduleName (sa, name, args, ty)       let args' = args `withKinds` kind-      addTypeSynonym moduleName name args' ty kind+      addTypeSynonym moduleName name args' elabTy kind     return $ TypeSynonymDeclaration sa name args ty+  go (KindDeclaration sa@(ss, _) kindFor name ty) = do+    warnAndRethrow (addHint (ErrorInKindDeclaration name) . addHint (positionedError ss)) $ do+      elabTy <- withFreshSubstitution $ checkKindDeclaration moduleName ty+      env <- getEnv+      putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (elabTy, LocalTypeVariable) (types env) }+      return $ KindDeclaration sa kindFor name elabTy+  go d@(RoleDeclaration (RoleDeclarationData _sa name roles)) = do+    addExplicitRoleDeclaration moduleName name roles+    return d   go TypeDeclaration{} =     internalError "Type declarations should have been removed before typeCheckAlld"   go (ValueDecl sa@(ss, _) name nameKind [] [MkUnguarded val]) = do@@ -289,7 +353,6 @@           addValue moduleName name ty nameKind           return $ ValueDecl sa name nameKind [] [MkUnguarded val'']         _ -> internalError "typesOf did not return a singleton"-    where   go ValueDeclaration{} = internalError "Binders were not desugared"   go BoundValueDeclaration{} = internalError "BoundValueDeclaration should be desugared"   go (BindingGroupDeclaration vals) = do@@ -308,33 +371,36 @@         return (sai, nameKind, val)       return . BindingGroupDeclaration $ NEL.fromList vals''   go (d@(ExternDataDeclaration _ name kind)) = do-    env <- getEnv-    putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }-    return d-  go (d@(ExternKindDeclaration _ name)) = do+    elabKind <- withFreshSubstitution $ checkKindDeclaration moduleName kind     env <- getEnv-    putEnv $ env { kinds = S.insert (Qualified (Just moduleName) name) (kinds env) }+    let qualName = Qualified (Just moduleName) name+    -- If there's an explicit role declaration, just trust it+    let roles = fromMaybe (nominalRolesForKind elabKind) $ M.lookup qualName (roleDeclarations env)+    putEnv $ env { types = M.insert qualName (elabKind, ExternData roles) (types env) }     return d   go (d@(ExternDeclaration (ss, _) name ty)) = do     warnAndRethrow (addHint (ErrorInForeignImport name) . addHint (positionedError ss)) $ do       env <- getEnv-      kind <- kindOf ty-      guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType+      (elabTy, kind) <- withFreshSubstitution $ do+        ((unks, ty'), kind) <- kindOfWithUnknowns ty+        pure (varIfUnknown unks ty', kind)+      checkTypeKind elabTy kind       case M.lookup (Qualified (Just moduleName) name) (names env) of         Just _ -> throwError . errorMessage $ RedefinedIdent name-        Nothing -> putEnv (env { names = M.insert (Qualified (Just moduleName) name) (ty, External, Defined) (names env) })+        Nothing -> putEnv (env { names = M.insert (Qualified (Just moduleName) name) (elabTy, External, Defined) (names env) })     return d   go d@FixityDeclaration{} = return d   go d@ImportDeclaration{} = return d-  go d@(TypeClassDeclaration (ss, _) pn args implies deps tys) = do+  go d@(TypeClassDeclaration sa@(ss, _) pn args implies deps tys) = do     warnAndRethrow (addHint (ErrorInTypeClassDeclaration pn) . addHint (positionedError ss)) $ do       env <- getEnv       let qualifiedClassName = Qualified (Just moduleName) pn       guardWith (errorMessage (DuplicateTypeClass pn ss)) $         not (M.member qualifiedClassName (typeClasses env))-      addTypeClass qualifiedClassName args implies deps tys+      (args', implies', tys', kind) <- kindOfClass moduleName (sa, pn, args, implies, tys)+      addTypeClass moduleName qualifiedClassName (fmap Just <$> args') implies' deps tys' kind       return d-  go (d@(TypeInstanceDeclaration (ss, _) ch idx dictName deps className tys body)) =+  go (d@(TypeInstanceDeclaration sa@(ss, _) ch idx dictName deps className tys body)) =     rethrow (addHint (ErrorInInstance className tys) . addHint (positionedError ss)) $ do       env <- getEnv       let qualifiedDictName = Qualified (Just moduleName) dictName@@ -345,14 +411,16 @@         Nothing -> internalError "typeCheckAll: Encountered unknown type class in instance declaration"         Just typeClass -> do           checkInstanceArity dictName className typeClass tys-          sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys)-          let nonOrphanModules = findNonOrphanModules className typeClass tys-          checkOrphanInstance dictName className tys nonOrphanModules+          (deps', kinds', tys', vars) <- withFreshSubstitution $ checkInstanceDeclaration moduleName (sa, deps, className, tys)+          tys'' <- traverse replaceAllTypeSynonyms tys'+          sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys'')+          let nonOrphanModules = findNonOrphanModules className typeClass tys''+          checkOrphanInstance dictName className tys'' nonOrphanModules           let qualifiedChain = Qualified (Just moduleName) <$> ch-          checkOverlappingInstance qualifiedChain dictName className typeClass tys nonOrphanModules+          checkOverlappingInstance qualifiedChain dictName className typeClass tys'' nonOrphanModules           _ <- traverseTypeInstanceBody checkInstanceMembers body-          deps' <- (traverse . overConstraintArgs . traverse) replaceAllTypeSynonyms deps-          let dict = TypeClassDictionaryInScope qualifiedChain idx qualifiedDictName [] className tys (Just deps')+          deps'' <- (traverse . overConstraintArgs . traverse) replaceAllTypeSynonyms deps'+          let dict = TypeClassDictionaryInScope qualifiedChain idx qualifiedDictName [] className vars kinds' tys'' (Just deps'')           addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) (pure dict)           return d @@ -396,6 +464,8 @@     typeModule (TypeConstructor _ (Qualified (Just mn'') _)) = Just mn''     typeModule (TypeConstructor _ (Qualified Nothing _)) = internalError "Unqualified type name in findNonOrphanModules"     typeModule (TypeApp _ t1 _) = typeModule t1+    typeModule (KindApp _ t1 _) = typeModule t1+    typeModule (KindedType _ t1 _) = typeModule t1     typeModule _ = internalError "Invalid type in instance in findNonOrphanModules"      modulesByTypeIndex :: M.Map Int (Maybe ModuleName)@@ -417,7 +487,7 @@   -- Check that the instance currently being declared doesn't overlap with any   -- other instance in any module that this instance wouldn't be considered an   -- orphan in.  There are overlapping instance situations that won't be caught-  -- by this, for example when combining multiparametr type classes with+  -- by this, for example when combining multiparameter type classes with   -- flexible instances: the instances `Cls X y` and `Cls x Y` overlap and   -- could live in different modules but won't be caught here.   checkOverlappingInstance@@ -493,12 +563,24 @@   -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,   -- extracted from the kind of the type constructor itself.   ---  withKinds :: [(Text, Maybe SourceKind)] -> SourceKind -> [(Text, Maybe SourceKind)]-  withKinds []                  _               = []-  withKinds (s@(_, Just _ ):ss) (FunKind _ _   k) = s : withKinds ss k-  withKinds (  (s, Nothing):ss) (FunKind _ k1 k2) = (s, Just k1) : withKinds ss k2-  withKinds _                   _                 = internalError "Invalid arguments to peelKinds"+  withKinds :: [(Text, Maybe SourceType)] -> SourceType -> [(Text, Maybe SourceType)]+  withKinds [] _ = []+  withKinds ss (ForAll _ _ _ k _) = withKinds ss k+  withKinds (s@(_, Just _):ss) (TypeApp _ (TypeApp _ tyFn _) k2) | eqType tyFn tyFunction = s : withKinds ss k2+  withKinds ((s, Nothing):ss) (TypeApp _ (TypeApp _ tyFn k1) k2) | eqType tyFn tyFunction = (s, Just k1) : withKinds ss k2+  withKinds _ _ = internalError "Invalid arguments to withKinds" +  withRoles :: [(Text, Maybe SourceType)] -> [Role] -> [(Text, Maybe SourceType, Role)]+  withRoles = zipWith $ \(v, k) r -> (v, k, r)++  replaceTypeSynonymsInDataConstructor :: DataConstructorDeclaration -> m DataConstructorDeclaration+  replaceTypeSynonymsInDataConstructor DataConstructorDeclaration{..} = do+    dataCtorFields' <- traverse (traverse replaceAllTypeSynonyms) dataCtorFields+    return DataConstructorDeclaration+      { dataCtorFields = dataCtorFields'+      , ..+      }+ checkNewtype   :: forall m    . MonadError MultipleErrors m@@ -515,22 +597,50 @@ typeCheckModule   :: forall m    . (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)-  => Module+  => M.Map ModuleName Exports+  -> Module   -> m Module-typeCheckModule (Module _ _ _ _ Nothing) =+typeCheckModule _ (Module _ _ _ _ Nothing) =   internalError "exports should have been elaborated before typeCheckModule"-typeCheckModule (Module ss coms mn decls (Just exps)) =+typeCheckModule modulesExports (Module ss coms mn decls (Just exps)) =   warnAndRethrow (addHint (ErrorInModule mn)) $ do-    modify (\s -> s { checkCurrentModule = Just mn })-    decls' <- typeCheckAll mn exps decls+    let (decls', imports) = partitionEithers $ fromImportDecl <$> decls+    modify (\s -> s { checkCurrentModule = Just mn, checkCurrentModuleImports = imports })+    decls'' <- typeCheckAll mn exps decls'     checkSuperClassesAreExported <- getSuperClassExportCheck     for_ exps $ \e -> do       checkTypesAreExported e       checkClassMembersAreExported e       checkClassesAreExported e       checkSuperClassesAreExported e-    return $ Module ss coms mn decls' (Just exps)+      checkDataConstructorsAreExported e+    return $ Module ss coms mn (map toImportDecl imports ++ decls'') (Just exps)   where++  fromImportDecl+    :: Declaration+    -> Either Declaration+              ( SourceAnn+              , ModuleName+              , ImportDeclarationType+              , Maybe ModuleName+              , M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)+              )+  fromImportDecl (ImportDeclaration sa moduleName importDeclarationType asModuleName) =+    Right (sa, moduleName, importDeclarationType, asModuleName, foldMap exportedTypes $ M.lookup moduleName modulesExports)+  fromImportDecl decl = Left decl++  toImportDecl+    :: ( SourceAnn+       , ModuleName+       , ImportDeclarationType+       , Maybe ModuleName+       , M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)+       )+    -> Declaration+  toImportDecl (sa, moduleName, importDeclarationType, asModuleName, _) =+    ImportDeclaration sa moduleName importDeclarationType asModuleName+   qualify' :: a -> Qualified a   qualify' = Qualified (Just mn) @@ -573,10 +683,11 @@   checkMemberExport extract dr@(TypeRef _ name dctors) = do     env <- getEnv     for_ (M.lookup (qualify' name) (types env)) $ \(k, _) -> do-      let findModuleKinds = everythingOnKinds (++) $ \case-            NamedKind _ (Qualified (Just mn') kindName) | mn' == mn -> [kindName]-            _ -> []-      checkExport dr $ KindRef (declRefSourceSpan dr) <$> findModuleKinds k+      -- TODO: remove?+      -- let findModuleKinds = everythingOnTypes (++) $ \case+      --       TypeConstructor _ (Qualified (Just mn') kindName) | mn' == mn -> [kindName]+      --       _ -> []+      checkExport dr (extract k)     for_ (M.lookup (qualify' name) (typeSynonyms env)) $ \(_, ty) ->       checkExport dr (extract ty)     for_ dctors $ \dctors' ->@@ -616,7 +727,6 @@     where     exported e = any (exports e) exps     exports (TypeRef _ pn1 _) (TypeRef _ pn2 _) = pn1 == pn2-    exports (KindRef _ pn1) (KindRef _ pn2) = pn1 == pn2     exports (ValueRef _ id1) (ValueRef _ id2) = id1 == id2     exports (TypeClassRef _ pn1) (TypeClassRef _ pn2) = pn1 == pn2     exports _ _ = False@@ -660,8 +770,41 @@     where     findClassMembers :: Declaration -> Maybe [Ident]     findClassMembers (TypeClassDeclaration _ name' _ _ _ ds) | name == name' = Just $ map extractMemberName ds+    findClassMembers (DataBindingGroupDeclaration decls') = headMay . mapMaybe findClassMembers $ NEL.toList decls'     findClassMembers _ = Nothing     extractMemberName :: Declaration -> Ident     extractMemberName (TypeDeclaration td) = tydeclIdent td     extractMemberName _ = internalError "Unexpected declaration in typeclass member list"   checkClassMembersAreExported _ = return ()++  -- If a type is exported without data constructors, we warn on `Generic` or `Newtype` instances.+  -- On the other hand if any data constructors are exported, we require all of them to be exported.+  checkDataConstructorsAreExported :: DeclarationRef -> m ()+  checkDataConstructorsAreExported dr@(TypeRef ss' name (fromMaybe [] -> exportedDataConstructorsNames))+    | null exportedDataConstructorsNames = for_+      [ DataGenericRep.Generic+      , DataNewtype.Newtype+      ] $ \className -> do+        env <- getEnv+        let dicts = foldMap (foldMap NEL.toList) $+              M.lookup (Just mn) (typeClassDictionaries env) >>= M.lookup className+        when (any isDictOfTypeRef dicts) $+          tell . errorMessage' ss' $ HiddenConstructors dr className+    | otherwise = do+      env <- getEnv+      let dataConstructorNames = fromMaybe [] $+            M.lookup (mkQualified name mn) (types env) >>= getDataConstructorNames . snd+          missingDataConstructorsNames = dataConstructorNames \\ exportedDataConstructorsNames+      unless (null missingDataConstructorsNames) $+        throwError . errorMessage' ss' $ TransitiveDctorExportError dr missingDataConstructorsNames+      where+      isDictOfTypeRef :: TypeClassDictionaryInScope a -> Bool+      isDictOfTypeRef dict+        | (TypeConstructor _ qualTyName, _, _) : _ <- unapplyTypes <$> tcdInstanceTypes dict+        , qualTyName == Qualified (Just mn) name+        = True+      isDictOfTypeRef _ = False+      getDataConstructorNames :: TypeKind -> Maybe [ProperName 'ConstructorName]+      getDataConstructorNames (DataType _ _ constructors) = Just $ fst <$> constructors+      getDataConstructorNames _ = Nothing+  checkDataConstructorsAreExported _ = return ()
src/Language/PureScript/TypeChecker/Entailment.hs view
@@ -24,7 +24,7 @@ import Data.Function (on) import Data.Functor (($>)) import Data.List (minimumBy, groupBy, nubBy, sortBy)-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Set as S import Data.Traversable (for)@@ -37,13 +37,16 @@ import Language.PureScript.Environment import Language.PureScript.Errors import Language.PureScript.Names+import Language.PureScript.TypeChecker.Entailment.Coercible+import Language.PureScript.TypeChecker.Kinds (elaborateKind, unifyKinds) import Language.PureScript.TypeChecker.Monad import Language.PureScript.TypeChecker.Unify import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types import Language.PureScript.Label (Label(..)) import Language.PureScript.PSString (PSString, mkString, decodeString)-import qualified Language.PureScript.Constants as C+import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Prim as C  -- | Describes what sort of dictionary to generate for type class instances data Evidence@@ -162,27 +165,35 @@ entails SolverOptions{..} constraint context hints =     solve constraint   where-    forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [SourceType] -> [TypeClassDict]-    forClassName ctx cn@C.Warn [msg] =+    forClassNameM :: Environment -> InstanceContext -> Qualified (ProperName 'ClassName) -> [SourceType] -> [SourceType] -> m [TypeClassDict]+    forClassNameM env ctx cn@C.Coercible kinds args =+      solveCoercible env ctx kinds args >>=+        pure . fromMaybe (forClassName env ctx cn kinds args)+    forClassNameM env ctx cn kinds args =+      pure $ forClassName env ctx cn kinds args++    forClassName :: Environment -> InstanceContext -> Qualified (ProperName 'ClassName) -> [SourceType] -> [SourceType] -> [TypeClassDict]+    forClassName _ ctx cn@C.Warn _ [msg] =       -- Prefer a warning dictionary in scope if there is one available.       -- This allows us to defer a warning by propagating the constraint.-      findDicts ctx cn Nothing ++ [TypeClassDictionaryInScope [] 0 (WarnInstance msg) [] C.Warn [msg] Nothing]-    forClassName _ C.IsSymbol args | Just dicts <- solveIsSymbol args = dicts-    forClassName _ C.SymbolCompare args | Just dicts <- solveSymbolCompare args = dicts-    forClassName _ C.SymbolAppend args | Just dicts <- solveSymbolAppend args = dicts-    forClassName _ C.SymbolCons args | Just dicts <- solveSymbolCons args = dicts-    forClassName _ C.RowUnion args | Just dicts <- solveUnion args = dicts-    forClassName _ C.RowNub args | Just dicts <- solveNub args = dicts-    forClassName _ C.RowLacks args | Just dicts <- solveLacks args = dicts-    forClassName _ C.RowCons args | Just dicts <- solveRowCons args = dicts-    forClassName _ C.RowToList args | Just dicts <- solveRowToList args = dicts-    forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (ordNub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))-    forClassName _ _ _ = internalError "forClassName: expected qualified class name"+      findDicts ctx cn Nothing ++ [TypeClassDictionaryInScope [] 0 (WarnInstance msg) [] C.Warn [] [] [msg] Nothing]+    forClassName _ _ C.IsSymbol _ args | Just dicts <- solveIsSymbol args = dicts+    forClassName _ _ C.SymbolCompare _ args | Just dicts <- solveSymbolCompare args = dicts+    forClassName _ _ C.SymbolAppend _ args | Just dicts <- solveSymbolAppend args = dicts+    forClassName _ _ C.SymbolCons _ args | Just dicts <- solveSymbolCons args = dicts+    forClassName _ _ C.RowUnion kinds args | Just dicts <- solveUnion kinds args = dicts+    forClassName _ _ C.RowNub kinds args | Just dicts <- solveNub kinds args = dicts+    forClassName _ _ C.RowLacks kinds args | Just dicts <- solveLacks kinds args = dicts+    forClassName _ _ C.RowCons kinds args | Just dicts <- solveRowCons kinds args = dicts+    forClassName _ _ C.RowToList kinds args | Just dicts <- solveRowToList kinds args = dicts+    forClassName _ ctx cn@(Qualified (Just mn) _) _ tys = concatMap (findDicts ctx cn) (ordNub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))+    forClassName _ _ _ _ _ = internalError "forClassName: expected qualified class name"      ctorModules :: SourceType -> Maybe ModuleName     ctorModules (TypeConstructor _ (Qualified (Just mn) _)) = Just mn     ctorModules (TypeConstructor _ (Qualified Nothing _)) = internalError "ctorModules: unqualified type name"     ctorModules (TypeApp _ ty _) = ctorModules ty+    ctorModules (KindApp _ ty _) = ctorModules ty     ctorModules (KindedType _ ty _) = ctorModules ty     ctorModules _ = Nothing @@ -196,18 +207,20 @@     solve con = go 0 con       where         go :: Int -> SourceConstraint -> WriterT (Any, [(Ident, InstanceContext, SourceConstraint)]) (StateT InstanceContext m) Expr-        go work (Constraint _ className' tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'-        go work con'@(Constraint _ className' tys' conInfo) = WriterT . StateT . (withErrorMessageHint (ErrorSolvingConstraint con') .) . runStateT . runWriterT $ do+        go work (Constraint _ className' _ tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'+        go work con'@(Constraint _ className' kinds' tys' conInfo) = WriterT . StateT . (withErrorMessageHint (ErrorSolvingConstraint con') .) . runStateT . runWriterT $ do             -- We might have unified types by solving other constraints, so we need to             -- apply the latest substitution.             latestSubst <- lift . lift $ gets checkSubstitution-            let tys'' = map (substituteType latestSubst) tys'+            let kinds'' = map (substituteType latestSubst) kinds'+                tys'' = map (substituteType latestSubst) tys'+             -- Get the inferred constraint context so far, and merge it with the global context             inferred <- lift get             -- We need information about functional dependencies, so we have to look up the class             -- name in the environment:-            classesInScope <- lift . lift $ gets (typeClasses . checkEnv)-+            env <- lift . lift $ gets checkEnv+            let classesInScope = typeClasses env             TypeClassData               { typeClassDependencies               , typeClassIsEmpty@@ -215,10 +228,12 @@                 Nothing -> throwError . errorMessage $ UnknownClass className'                 Just tcd -> pure tcd +            dicts <- lift . lift $ forClassNameM env (combineContexts context inferred) className' kinds'' tys''+             let instances = do                   chain <- groupBy ((==) `on` tcdChain) $                            sortBy (compare `on` (tcdChain &&& tcdIndex)) $-                           forClassName (combineContexts context inferred) className' tys''+                           dicts                   -- process instances in a chain in index order                   let found = for chain $ \tcd ->                                 -- Make sure the type unifies with the type in the type instance definition@@ -230,7 +245,7 @@                     Right _               -> []          -- all apart                     Left Nothing          -> []          -- last unknown                     Left (Just substsTcd) -> [substsTcd] -- found a match-            solution <- lift . lift $ unique tys'' instances+            solution <- lift . lift $ unique kinds'' tys'' instances             case solution of               Solved substs tcd -> do                 -- Note that we solved something.@@ -273,11 +288,11 @@               Deferred ->                 -- Constraint was deferred, just return the dictionary unchanged,                 -- with no unsolved constraints. Hopefully, we can solve this later.-                return (TypeClassDictionary (srcConstraint className' tys'' conInfo) context hints)+                return (TypeClassDictionary (srcConstraint className' kinds'' tys'' conInfo) context hints)           where             -- | When checking functional dependencies, we need to use unification to make             -- sure it is safe to use the selected instance. We will unify the solved type with-            -- the type in the instance head under the substition inferred from its instantiation.+            -- the type in the instance head under the substitution inferred from its instantiation.             -- As an example, when solving MonadState t0 (State Int), we choose the             -- MonadState s (State s) instance, and we unify t0 with Int, since the functional             -- dependency from MonadState dictates that t0 should unify with s\[s -> Int], which is@@ -285,36 +300,39 @@             -- from the type, so we end up with a unification error. So, any type arguments which             -- appear in the instance head, but not in the substitution need to be replaced with             -- fresh type variables. This function extends a substitution with fresh type variables-            -- as necessary, based on the types in the instance head.+            -- as necessary, based on the types in the instance head. It also unifies kinds based on+            -- the substitution so kind information propagates correctly through the solver.             withFreshTypes               :: TypeClassDict               -> Matching SourceType               -> m (Matching SourceType)-            withFreshTypes TypeClassDictionaryInScope{..} subst = do-                let onType = everythingOnTypes S.union fromTypeVar-                    typeVarsInHead = foldMap onType tcdInstanceTypes-                                  <> foldMap (foldMap (foldMap onType . constraintArgs)) tcdDependencies-                    typeVarsInSubst = S.fromList (M.keys subst)-                    uninstantiatedTypeVars = typeVarsInHead S.\\ typeVarsInSubst-                newSubst <- traverse withFreshType (S.toList uninstantiatedTypeVars)-                return (subst <> M.fromList newSubst)+            withFreshTypes TypeClassDictionaryInScope{..} initSubst = do+                subst <- foldM withFreshType initSubst $ filter (flip M.notMember initSubst . fst) tcdForAll+                for_ (M.toList initSubst) $ unifySubstKind subst+                pure subst               where-                fromTypeVar (TypeVar _ v) = S.singleton v-                fromTypeVar _ = S.empty+                withFreshType subst (var, kind) = do+                  ty <- freshTypeWithKind $ replaceAllTypeVars (M.toList subst) kind+                  pure $ M.insert var ty subst -                withFreshType s = do-                  t <- freshType-                  return (s, t)+                unifySubstKind subst (var, ty) =+                  for_ (lookup var tcdForAll) $ \instKind -> do+                    tyKind <- elaborateKind ty+                    currentSubst <- gets checkSubstitution+                    unifyKinds+                      (substituteType currentSubst . replaceAllTypeVars (M.toList subst) $ instKind)+                      (substituteType currentSubst tyKind) -            unique :: [SourceType] -> [(a, TypeClassDict)] -> m (EntailsResult a)-            unique tyArgs []+            unique :: [SourceType] -> [SourceType] -> [(a, TypeClassDict)] -> m (EntailsResult a)+            unique kindArgs tyArgs []               | solverDeferErrors = return Deferred               -- We need a special case for nullary type classes, since we want               -- to generalize over Partial constraints.-              | solverShouldGeneralize && (null tyArgs || any canBeGeneralized tyArgs) = return (Unsolved (srcConstraint className' tyArgs conInfo))-              | otherwise = throwError . errorMessage $ NoInstanceFound (srcConstraint className' tyArgs conInfo)-            unique _      [(a, dict)] = return $ Solved a dict-            unique tyArgs tcds+              | solverShouldGeneralize && ((null kindArgs && null tyArgs) || any canBeGeneralized kindArgs || any canBeGeneralized tyArgs) =+                  return (Unsolved (srcConstraint className' kindArgs tyArgs conInfo))+              | otherwise = throwError . errorMessage $ NoInstanceFound (srcConstraint className' kindArgs tyArgs conInfo)+            unique _ _ [(a, dict)] = return $ Solved a dict+            unique _ tyArgs tcds               | pairwiseAny overlapping (map snd tcds) =                   throwError . errorMessage $ OverlappingInstances className' tyArgs (tcds >>= (toList . namedInstanceIdentifier . tcdValue . snd))               | otherwise = return $ uncurry Solved (minimumBy (compare `on` length . tcdPath . snd) tcds)@@ -342,7 +360,7 @@             solveSubgoals :: Matching SourceType -> Maybe [SourceConstraint] -> WriterT (Any, [(Ident, InstanceContext, SourceConstraint)]) (StateT InstanceContext m) (Maybe [Expr])             solveSubgoals _ Nothing = return Nothing             solveSubgoals subst (Just subgoals) =-              Just <$> traverse (go (work + 1) . mapConstraintArgs (map (replaceAllTypeVars (M.toList subst)))) subgoals+              Just <$> traverse (go (work + 1) . mapConstraintArgsAll (map (replaceAllTypeVars (M.toList subst)))) subgoals              -- We need subgoal dictionaries to appear in the term somewhere             -- If there aren't any then the dictionary is just undefined@@ -368,8 +386,31 @@         subclassDictionaryValue dict className index =           App (Accessor (mkString (superclassName className index)) dict) valUndefined +    solveCoercible :: Environment -> InstanceContext -> [SourceType] -> [SourceType] -> m (Maybe [TypeClassDict])+    solveCoercible env ctx kinds [a, b] = do+      let coercibleDictsInScope = findDicts ctx C.Coercible Nothing+          givens = flip mapMaybe coercibleDictsInScope $ \case+            dict | [a', b'] <- tcdInstanceTypes dict -> Just (a', b')+                 | otherwise -> Nothing+      GivenSolverState{ inertGivens } <- execStateT (solveGivens env) $+        initialGivenSolverState givens+      (WantedSolverState{ inertWanteds }, hints') <- runWriterT . execStateT (solveWanteds env) $+        initialWantedSolverState inertGivens a b+      -- Solving fails when there's irreducible wanteds left.+      --+      -- We report the first residual constraint instead of the initial wanted,+      -- unless we just swapped its arguments.+      --+      -- We may have collected hints for the solving failure along the way, in+      -- which case we decorate the error with the first one.+      maybe id addHint (listToMaybe hints') `rethrow` case inertWanteds of+        [] -> pure $ Just [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.Coercible [] kinds [a, b] Nothing]+        (k, a', b') : _ | a' == b && b' == a -> throwError $ insoluble k b' a'+        (k, a', b') : _ -> throwError $ insoluble k a' b'+    solveCoercible _ _ _ _ = pure Nothing+     solveIsSymbol :: [SourceType] -> Maybe [TypeClassDict]-    solveIsSymbol [TypeLevelString ann sym] = Just [TypeClassDictionaryInScope [] 0 (IsSymbolInstance sym) [] C.IsSymbol [TypeLevelString ann sym] Nothing]+    solveIsSymbol [TypeLevelString ann sym] = Just [TypeClassDictionaryInScope [] 0 (IsSymbolInstance sym) [] C.IsSymbol [] [] [TypeLevelString ann sym] Nothing]     solveIsSymbol _ = Nothing      solveSymbolCompare :: [SourceType] -> Maybe [TypeClassDict]@@ -379,14 +420,14 @@                   EQ -> C.orderingEQ                   GT -> C.orderingGT           args' = [arg0, arg1, srcTypeConstructor ordering]-      in Just [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.SymbolCompare args' Nothing]+      in Just [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.SymbolCompare [] [] args' Nothing]     solveSymbolCompare _ = Nothing      solveSymbolAppend :: [SourceType] -> Maybe [TypeClassDict]     solveSymbolAppend [arg0, arg1, arg2] = do       (arg0', arg1', arg2') <- appendSymbols arg0 arg1 arg2       let args' = [arg0', arg1', arg2']-      pure [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.SymbolAppend args' Nothing]+      pure [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.SymbolAppend [] [] args' Nothing]     solveSymbolAppend _ = Nothing      -- | Append type level symbols, or, run backwards, strip a prefix or suffix@@ -408,7 +449,7 @@     solveSymbolCons [arg0, arg1, arg2] = do       (arg0', arg1', arg2') <- consSymbol arg0 arg1 arg2       let args' = [arg0', arg1', arg2']-      pure [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.SymbolCons args' Nothing]+      pure [TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.SymbolCons [] [] args' Nothing]     solveSymbolCons _ = Nothing      consSymbol :: SourceType -> SourceType -> SourceType -> Maybe (SourceType, SourceType, SourceType)@@ -423,79 +464,85 @@       pure (arg1, arg2, srcTypeLevelString (mkString $ h' <> t'))     consSymbol _ _ _ = Nothing -    solveUnion :: [SourceType] -> Maybe [TypeClassDict]-    solveUnion [l, r, u] = do-      (lOut, rOut, uOut, cst) <- unionRows l r u-      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowUnion [lOut, rOut, uOut] cst ]-    solveUnion _ = Nothing+    solveUnion :: [SourceType] -> [SourceType] -> Maybe [TypeClassDict]+    solveUnion kinds [l, r, u] = do+      (lOut, rOut, uOut, cst, vars) <- unionRows kinds l r u+      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowUnion vars kinds [lOut, rOut, uOut] cst ]+    solveUnion _ _ = Nothing      -- | Left biased union of two row types-    unionRows :: SourceType -> SourceType -> SourceType -> Maybe (SourceType, SourceType, SourceType, Maybe [SourceConstraint])-    unionRows l r _ =-        guard canMakeProgress $> (l, r, rowFromList out, cons)+    unionRows :: [SourceType] -> SourceType -> SourceType -> SourceType -> Maybe (SourceType, SourceType, SourceType, Maybe [SourceConstraint], [(Text, SourceType)])+    unionRows kinds l r _ =+        guard canMakeProgress $> (l, r, rowFromList out, cons, vars)       where         (fixed, rest) = rowToList l          rowVar = srcTypeVar "r" -        (canMakeProgress, out, cons) =+        (canMakeProgress, out, cons, vars) =           case rest of             -- If the left hand side is a closed row, then we can merge             -- its labels into the right hand side.-            REmpty _ -> (True, (fixed, r), Nothing)+            REmptyKinded _ _ -> (True, (fixed, r), Nothing, [])             -- If the left hand side is not definitely closed, then the only way we             -- can safely make progress is to move any known labels from the left             -- input into the output, and add a constraint for any remaining labels.             -- Otherwise, the left hand tail might contain the same labels as on             -- the right hand side, and we can't be certain we won't reorder the             -- types for such labels.-            _ -> (not (null fixed), (fixed, rowVar), Just [ srcConstraint C.RowUnion [rest, r, rowVar] Nothing ])+            _ -> ( not (null fixed)+                 , (fixed, rowVar)+                 , Just [ srcConstraint C.RowUnion kinds [rest, r, rowVar] Nothing ]+                 , [("r", kindRow (head kinds))]+                 ) -    solveRowCons :: [SourceType] -> Maybe [TypeClassDict]-    solveRowCons [TypeLevelString ann sym, ty, r, _] =-      Just [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowCons [TypeLevelString ann sym, ty, r, srcRCons (Label sym) ty r] Nothing ]-    solveRowCons _ = Nothing+    solveRowCons :: [SourceType] -> [SourceType] -> Maybe [TypeClassDict]+    solveRowCons kinds [TypeLevelString ann sym, ty, r, _] =+      Just [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowCons [] kinds [TypeLevelString ann sym, ty, r, srcRCons (Label sym) ty r] Nothing ]+    solveRowCons _ _ = Nothing -    solveRowToList :: [SourceType] -> Maybe [TypeClassDict]-    solveRowToList [r, _] = do-      entries <- rowToRowList r-      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowToList [r, entries] Nothing ]-    solveRowToList _ = Nothing+    solveRowToList :: [SourceType] -> [SourceType] -> Maybe [TypeClassDict]+    solveRowToList [kind] [r, _] = do+      entries <- rowToRowList kind r+      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowToList [] [kind] [r, entries] Nothing ]+    solveRowToList _ _ = Nothing      -- | Convert a closed row to a sorted list of entries-    rowToRowList :: SourceType -> Maybe SourceType-    rowToRowList r =-        guard (eqType rest $ REmpty ()) $>-        foldr rowListCons (srcTypeConstructor C.RowListNil) fixed+    rowToRowList :: SourceType -> SourceType -> Maybe SourceType+    rowToRowList kind r =+        guard (isREmpty rest) $>+        foldr rowListCons (srcKindApp (srcTypeConstructor C.RowListNil) kind) fixed       where         (fixed, rest) = rowToSortedList r         rowListCons (RowListItem _ lbl ty) tl =-          foldl srcTypeApp (srcTypeConstructor C.RowListCons)+          foldl srcTypeApp (srcKindApp (srcTypeConstructor C.RowListCons) kind)             [ srcTypeLevelString (runLabel lbl)             , ty             , tl ] -    solveNub :: [SourceType] -> Maybe [TypeClassDict]-    solveNub [r, _] = do+    solveNub :: [SourceType] -> [SourceType] -> Maybe [TypeClassDict]+    solveNub kinds [r, _] = do       r' <- nubRows r-      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowNub [r, r'] Nothing ]-    solveNub _ = Nothing+      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowNub [] kinds [r, r'] Nothing ]+    solveNub _ _ = Nothing      nubRows :: SourceType -> Maybe SourceType     nubRows r =-        guard (eqType rest $ REmpty ()) $>+        guard (isREmpty rest) $>         rowFromList (nubBy ((==) `on` rowListLabel) fixed, rest)       where         (fixed, rest) = rowToSortedList r -    solveLacks :: [SourceType] -> Maybe [TypeClassDict]-    solveLacks [TypeLevelString ann sym, r] = do-      (r', cst) <- rowLacks sym r-      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowLacks [TypeLevelString ann sym, r'] cst ]-    solveLacks _ = Nothing+    solveLacks :: [SourceType] -> [SourceType] -> Maybe [TypeClassDict]+    solveLacks kinds tys@[_, REmptyKinded _ _] =+      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowLacks [] kinds tys Nothing ]+    solveLacks kinds [TypeLevelString ann sym, r] = do+      (r', cst) <- rowLacks kinds sym r+      pure [ TypeClassDictionaryInScope [] 0 EmptyClassInstance [] C.RowLacks [] kinds [TypeLevelString ann sym, r'] cst ]+    solveLacks _ _ = Nothing -    rowLacks :: PSString -> SourceType -> Maybe (SourceType, Maybe [SourceConstraint])-    rowLacks sym r =+    rowLacks :: [SourceType] -> PSString -> SourceType -> Maybe (SourceType, Maybe [SourceConstraint])+    rowLacks kinds sym r =         guard (lacksSym && canMakeProgress) $> (r, cst)       where         (fixed, rest) = rowToList r@@ -504,8 +551,8 @@           not $ sym `elem` (runLabel . rowListLabel <$> fixed)          (canMakeProgress, cst) = case rest of-            REmpty _ -> (True, Nothing)-            _ -> (not (null fixed), Just [ srcConstraint C.RowLacks [srcTypeLevelString sym, rest] Nothing ])+            REmptyKinded _ _ -> (True, Nothing)+            _ -> (not (null fixed), Just [ srcConstraint C.RowLacks kinds [srcTypeLevelString sym, rest] Nothing ])  -- Check if an instance matches our list of types, allowing for types -- to be solved via functional dependencies. If the types match, we return a@@ -555,12 +602,14 @@     typeHeadsAreEqual (KindedType _  t1 _) t2                                  = typeHeadsAreEqual t1 t2     typeHeadsAreEqual t1                     (KindedType _ t2 _)               = typeHeadsAreEqual t1 t2     typeHeadsAreEqual (TUnknown _ u1)        (TUnknown _ u2)      | u1 == u2   = (Match (), M.empty)-    typeHeadsAreEqual (Skolem _ _ s1 _)      (Skolem _ _ s2 _)    | s1 == s2   = (Match (), M.empty)+    typeHeadsAreEqual (Skolem _ _ _ s1 _)      (Skolem _ _ _ s2 _)    | s1 == s2   = (Match (), M.empty)     typeHeadsAreEqual t                      (TypeVar _ v)                     = (Match (), M.singleton v [t])     typeHeadsAreEqual (TypeConstructor _ c1) (TypeConstructor _ c2) | c1 == c2 = (Match (), M.empty)     typeHeadsAreEqual (TypeLevelString _ s1) (TypeLevelString _ s2) | s1 == s2 = (Match (), M.empty)     typeHeadsAreEqual (TypeApp _ h1 t1)      (TypeApp _ h2 t2)                 =       both (typeHeadsAreEqual h1 h2) (typeHeadsAreEqual t1 t2)+    typeHeadsAreEqual (KindApp _ h1 t1)      (KindApp _ h2 t2)                 =+      both (typeHeadsAreEqual h1 h2) (typeHeadsAreEqual t1 t2)     typeHeadsAreEqual (REmpty _) (REmpty _) = (Match (), M.empty)     typeHeadsAreEqual r1@RCons{} r2@RCons{} =         foldr both (uncurry go rest) common@@ -570,17 +619,17 @@         go :: ([RowListItem a], Type a) -> ([RowListItem a], Type a) -> (Matched (), Matching [Type a])         go (l,  KindedType _ t1 _) (r,  t2)                            = go (l, t1) (r, t2)         go (l,  t1)                (r,  KindedType _ t2 _)             = go (l, t1) (r, t2)+        go (l,  KindApp _ t1 k1)   (r,  KindApp _ t2 k2) | eqType k1 k2 = go (l, t1) (r, t2)         go ([], REmpty _)          ([], REmpty _)                      = (Match (), M.empty)         go ([], TUnknown _ u1)     ([], TUnknown _ u2)      | u1 == u2 = (Match (), M.empty)         go ([], TypeVar _ v1)      ([], TypeVar _ v2)       | v1 == v2 = (Match (), M.empty)-        go ([], Skolem _ _ sk1 _)  ([], Skolem _ _ sk2 _) | sk1 == sk2 = (Match (), M.empty)+        go ([], Skolem _ _ _ sk1 _)  ([], Skolem _ _ _ sk2 _) | sk1 == sk2 = (Match (), M.empty)         go ([], TUnknown _ _)      _                                   = (Unknown, M.empty)         go (sd, r)                 ([], TypeVar _ v)                   = (Match (), M.singleton v [rowFromList (sd, r)])         go _ _                                                         = (Apart, M.empty)     typeHeadsAreEqual (TUnknown _ _) _ = (Unknown, M.empty)     typeHeadsAreEqual _ _ = (Apart, M.empty) -     both :: (Matched (), Matching [Type a]) -> (Matched (), Matching [Type a]) -> (Matched (), Matching [Type a])     both (b1, m1) (b2, m2) = (b1 <> b2, M.unionWith (++) m1 m2) @@ -596,13 +645,14 @@       typesAreEqual (KindedType _ t1 _)    t2                     = typesAreEqual t1 t2       typesAreEqual t1                     (KindedType _ t2 _)    = typesAreEqual t1 t2       typesAreEqual (TUnknown _ u1)        (TUnknown _ u2)        | u1 == u2 = Match ()-      typesAreEqual (Skolem _ _ s1 _)      (Skolem _ _ s2 _)      | s1 == s2 = Match ()-      typesAreEqual (Skolem _ _ _ _)       _                      = Unknown-      typesAreEqual _                      (Skolem _ _ _ _)       = Unknown+      typesAreEqual (Skolem _ _ _ s1 _)      (Skolem _ _ _ s2 _)      | s1 == s2 = Match ()+      typesAreEqual (Skolem _ _ _ _ _)       _                      = Unknown+      typesAreEqual _                      (Skolem _ _ _ _ _)       = Unknown       typesAreEqual (TypeVar _ v1)         (TypeVar _ v2)         | v1 == v2 = Match ()       typesAreEqual (TypeLevelString _ s1) (TypeLevelString _ s2) | s1 == s2 = Match ()       typesAreEqual (TypeConstructor _ c1) (TypeConstructor _ c2) | c1 == c2 = Match ()       typesAreEqual (TypeApp _ h1 t1)      (TypeApp _ h2 t2)      = typesAreEqual h1 h2 <> typesAreEqual t1 t2+      typesAreEqual (KindApp _ h1 t1)      (KindApp _ h2 t2)      = typesAreEqual h1 h2 <> typesAreEqual t1 t2       typesAreEqual (REmpty _)             (REmpty _)             = Match ()       typesAreEqual r1                     r2                     | isRCons r1 || isRCons r2 =           let (common, rest) = alignRowsWith typesAreEqual r1 r2@@ -611,10 +661,11 @@           go :: ([RowListItem a], Type a) -> ([RowListItem a], Type a) -> Matched ()           go (l, KindedType _ t1 _) (r, t2)                           = go (l, t1) (r, t2)           go (l, t1)                (r, KindedType _ t2 _)            = go (l, t1) (r, t2)+          go ([], KindApp _ t1 k1)  ([], KindApp _ t2 k2)             = typesAreEqual t1 t2 <> typesAreEqual k1 k2           go ([], TUnknown _ u1)    ([], TUnknown _ u2)    | u1 == u2 = Match ()-          go ([], Skolem _ _ s1 _)  ([], Skolem _ _ s2 _)  | s1 == s2 = Match ()-          go ([], Skolem _ _ _ _)   _                                 = Unknown-          go _                      ([], Skolem _ _ _ _)              = Unknown+          go ([], Skolem _ _ _ s1 _)  ([], Skolem _ _ _ s2 _)  | s1 == s2 = Match ()+          go ([], Skolem _ _ _ _ _)   _                               = Unknown+          go _                      ([], Skolem _ _ _ _ _)            = Unknown           go ([], REmpty _)         ([], REmpty _)                    = Match ()           go ([], TypeVar _ v1)     ([], TypeVar _ v2)     | v1 == v2 = Match ()           go _  _                                                     = Apart@@ -632,18 +683,19 @@   -> Qualified Ident   -> SourceConstraint   -> m [NamedDict]-newDictionaries path name (Constraint _ className instanceTy _) = do+newDictionaries path name (Constraint _ className instanceKinds instanceTy _) = do     tcs <- gets (typeClasses . checkEnv)     let TypeClassData{..} = fromMaybe (internalError "newDictionaries: type class lookup failed") $ M.lookup className tcs-    supDicts <- join <$> zipWithM (\(Constraint ann supName supArgs _) index ->+    supDicts <- join <$> zipWithM (\(Constraint ann supName supKinds supArgs _) index ->+                                      let sub = zip (map fst typeClassArguments) instanceTy in                                       newDictionaries ((supName, index) : path)                                                       name-                                                      (Constraint ann supName (instantiateSuperclass (map fst typeClassArguments) supArgs instanceTy) Nothing)+                                                      (Constraint ann supName+                                                        (replaceAllTypeVars sub <$> supKinds)+                                                        (replaceAllTypeVars sub <$> supArgs)+                                                        Nothing)                                   ) typeClassSuperclasses [0..]-    return (TypeClassDictionaryInScope [] 0 name path className instanceTy Nothing : supDicts)-  where-    instantiateSuperclass :: [Text] -> [SourceType] -> [SourceType] -> [SourceType]-    instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs+    return (TypeClassDictionaryInScope [] 0 name path className [] instanceKinds instanceTy Nothing : supDicts)  mkContext :: [NamedDict] -> InstanceContext mkContext = foldr combineContexts M.empty . map fromDict where
+ src/Language/PureScript/TypeChecker/Entailment/Coercible.hs view
@@ -0,0 +1,940 @@+{-# LANGUAGE DuplicateRecordFields #-}++-- |+-- Interaction solver for Coercible constraints+--+module Language.PureScript.TypeChecker.Entailment.Coercible+  ( GivenSolverState(..)+  , initialGivenSolverState+  , solveGivens+  , WantedSolverState(..)+  , initialWantedSolverState+  , solveWanteds+  , insoluble+  ) where++import Prelude.Compat hiding (interact)++import Control.Applicative ((<|>), empty)+import Control.Arrow ((&&&))+import Control.Monad ((<=<), guard, when)+import Control.Monad.Error.Class (MonadError, catchError, throwError)+import Control.Monad.State (MonadState, StateT, get, gets, modify, put)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)+import Control.Monad.Writer.Strict (MonadWriter, Writer, execWriter, runWriter, runWriterT, tell)+import Data.Either (partitionEithers)+import Data.Foldable (fold, foldl', for_, toList)+import Data.Functor (($>))+import Data.List (find)+import Data.Maybe (fromMaybe, isJust)+import Data.Monoid (Any(..))+import Data.Text (Text)++import qualified Data.Map as M+import qualified Data.Set as S++import Language.PureScript.Crash+import Language.PureScript.Environment+import Language.PureScript.Errors hiding (inScope)+import Language.PureScript.Names+import Language.PureScript.TypeChecker.Kinds hiding (kindOf)+import Language.PureScript.TypeChecker.Monad+import Language.PureScript.TypeChecker.Roles+import Language.PureScript.TypeChecker.Synonyms+import Language.PureScript.TypeChecker.Unify+import Language.PureScript.Roles+import Language.PureScript.Types+import qualified Language.PureScript.Constants.Prim as Prim++-- | State of the given constraints solver.+data GivenSolverState =+  GivenSolverState+    { inertGivens :: [(SourceType, SourceType, SourceType)]+  -- ^ A set of irreducible given constraints which do not interact together.+    , unsolvedGivens :: [(SourceType, SourceType)]+  -- ^ Given constraints yet to be solved.+    }++-- | Initialize the given constraints solver state with the givens to solve.+initialGivenSolverState :: [(SourceType, SourceType)] -> GivenSolverState+initialGivenSolverState =+  GivenSolverState []++-- | The given constraints solver follows these steps:+--+-- 1. Solving can diverge for recursive newtypes, so we check the solver depth+-- and abort if we crossed an arbitrary limit.+--+-- For instance the declarations:+--+-- @+-- newtype N a = N (a -> N a)+--+-- example :: forall a b. N a -> N b+-- example = coerce+-- @+--+-- yield the wanted @Coercible (N a) (N b)@ which we can unwrap on both sides+-- to yield @Coercible (a -> N a) (b -> N b)@, which we can then decompose back+-- to @Coercible a b@ and @Coercible (N a) (N b)@.+--+-- 2. We pick a constraint from the unsolved queue. If the queue is empty we are+-- done, otherwise we unify the constraint arguments kinds and continue.+--+-- 3. Then we try to canonicalize the constraint.++-- 3a. Canonicalization can fail, in which case we swallow the error and pretend+-- the constraint is irreducible because it is possible to eventually solve it.+--+-- For instance the declarations:+--+-- @+-- data D a = D a+-- type role D nominal+--+-- example :: forall a b. Coercible (D a) (D b) => D a -> D b+-- example = coerce+-- @+--+-- yield an insoluble given @Coercible (D a) (D b)@ which discharges the wanted+-- constraint regardless, because the given can be solved if @a@ and @b@ turn+-- out to be equal: @example (D true) :: D Boolean@ should compile.+--+-- 3b. Canonicalization can succeed with an irreducible constraint which we+-- then interact with the inert set.+--+-- 3bi. These interactions can yield a derived constraint which we add to the+-- unsolved queue and then go back to 1.+--+-- 3bii. These interactions can discharge the constraint, in which case we go+-- back to 1.+--+-- 3biii The constraint may not react to the inert set, in which case we add it+-- to the inert set, kick out any constraint that can be rewritten by the new+-- inert, add them to the unsolved queue and then go back to 1.+--+-- 3c. Otherwise canonicalization can succeed with derived constraints which we+-- add to the unsolved queue and then go back to 1.+solveGivens+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => Environment+  -> StateT GivenSolverState m ()+solveGivens env = go (0 :: Int) where+  go n = do+    when (n > 1000) . throwError . errorMessage $ PossiblyInfiniteCoercibleInstance+    gets unsolvedGivens >>= \case+      [] -> pure ()+      given : unsolved -> do+        (k, a, b) <- lift $ unify given+        GivenSolverState{..} <- get+        lift (fst <$> runWriterT (canon env Nothing k a b `catchError` recover)) >>= \case+          Irreducible -> case interact env (a, b) inertGivens of+            Just (Simplified (a', b')) ->+              put $ GivenSolverState { unsolvedGivens = (a', b') : unsolved, .. }+            Just Discharged ->+              put $ GivenSolverState { unsolvedGivens = unsolved, .. }+            Nothing -> do+              let (kickedOut, kept) = partitionEithers $ kicksOut env (a, b) <$> inertGivens+              put $ GivenSolverState+                { inertGivens = (k, a, b) : kept+                , unsolvedGivens = kickedOut <> unsolved+                }+          Canonicalized deriveds ->+            put $ GivenSolverState { unsolvedGivens = toList deriveds <> unsolved, .. }+        go (n + 1)+  recover _ = pure Irreducible++-- | State of the wanted constraints solver.+data WantedSolverState =+  WantedSolverState+    { inertGivens :: [(SourceType, SourceType, SourceType)]+  -- ^ A set of irreducible given constraints which do not interact together,+  -- but which could interact with the wanteds.+    , inertWanteds :: [(SourceType, SourceType, SourceType)]+  -- ^ A set of irreducible wanted constraints which do not interact together,+  -- nor with any given.+    , unsolvedWanteds :: [(SourceType, SourceType)]+  -- ^ Wanted constraints yet to be solved.+    }++-- | Initialize the wanted constraints solver state with an inert set of givens+-- and the two parameters of the wanted to solve.+initialWantedSolverState+  :: [(SourceType, SourceType, SourceType)]+  -> SourceType+  -> SourceType+  -> WantedSolverState+initialWantedSolverState givens a b =+  WantedSolverState givens [] [(a, b)]++-- | The wanted constraints solver follows similar steps than the given solver,+-- except for:+--+-- 1. When canonicalization fails we can swallow the error, but only if the+-- wanted interacts with the givens.+--+-- For instance the declarations:+--+-- @+-- data D a = D a+-- type role D nominal+--+-- example :: forall a b. Coercible (D a) (D b) => D a -> D b+-- example = coerce+-- @+--+-- yield an insoluble wanted @Coercible (D a) (D b)@ which is discharged by+-- the given. But we want @example :: forall a b. D a -> D b@ to fail.+--+-- 2. Irreducible wanted constraints don't interact with the inert wanteds set,+-- because doing so would yield confusing error messages.+--+-- For instance the declarations:+--+-- @+-- data D a = D a+--+-- example :: forall a. D a a -> D Boolean Char+-- example = coerce+-- @+--+-- yield the wanted @Coercible (D a a) (D Boolean Char)@, which is decomposed to+-- the irreducibles @Coercible a Boolean@ and @Coercible a Char@. Would we+-- interact the latter with the former, we would report an insoluble+-- @Coercible Boolean Char@.+solveWanteds+  :: MonadError MultipleErrors m+  => MonadWriter [ErrorMessageHint] m+  => MonadState CheckState m+  => Environment+  -> StateT WantedSolverState m ()+solveWanteds env = go (0 :: Int) where+  go n = do+    when (n > 1000) . throwError . errorMessage $ PossiblyInfiniteCoercibleInstance+    gets unsolvedWanteds >>= \case+      [] -> pure ()+      wanted : unsolved -> do+        (k, a, b) <- lift $ unify wanted+        WantedSolverState{..} <- get+        lift (canon env (Just inertGivens) k a b `catchError` recover (a, b) inertGivens) >>= \case+          Irreducible -> case interact env (a, b) inertGivens of+            Just (Simplified (a', b')) ->+              put $ WantedSolverState { unsolvedWanteds = (a', b') : unsolved, .. }+            Just Discharged ->+              put $ WantedSolverState { unsolvedWanteds = unsolved, .. }+            Nothing ->+              put $ WantedSolverState+                { inertWanteds = (k, a, b) : inertWanteds+                , unsolvedWanteds = unsolved+                , ..+                }+          Canonicalized deriveds ->+            put $ WantedSolverState { unsolvedWanteds = toList deriveds <> unsolved, .. }+        go (n + 1)+  recover wanted givens errors =+    case interact env wanted givens of+      Nothing -> throwError errors+      Just (Simplified wanted') -> pure . Canonicalized $ S.singleton wanted'+      Just Discharged -> pure $ Canonicalized mempty++-- | Unifying constraints arguments kinds isn't strictly necessary but yields+-- better error messages. For instance we cannot solve the constraint+-- @Coercible (D :: Type -> Type) (D a :: Type)@ because its arguments kinds+-- don't match and trying to unify them will say so, which is more helpful than+-- simply saying that no type class instance was found.+--+-- A subtle thing to note is that types with polymorphic kinds can be annotated+-- with kind applications mentioning unknowns that we may have solved by+-- unifying the kinds.+--+-- For instance the declarations:+--+-- @+-- data D :: forall k. k -> Type+-- data D a = D+--+-- type role D representational+--+-- example :: D D -> D D+-- example = coerce+-- @+--+-- yield a wanted+-- @Coercible (D \@(k1 -> Type) (D \@k1)) (D \@(k2 -> Type) (D \@k2))@, which we+-- decompose to @Coercible (D \@k1) (D \@k2)@, where @k1@ and @k2@ are unknowns.+-- This constraint is not reflexive because @D \@k1@ and @D \@k2@ are differents+-- but both arguments kinds unify with @k -> Type@, where @k@ is a fresh unknown,+-- so applying the substitution to @D \@k1@ and @D \@k2@ yields a+-- @Coercible (D \@k) (D \@k)@ constraint which could be trivially solved by+-- reflexivity instead of having to saturate the type constructors.+unify+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => (SourceType, SourceType)+  -> m (SourceType, SourceType, SourceType)+unify (a, b) = do+  let kindOf = sequence . (id &&& elaborateKind) <=< replaceAllTypeSynonyms+  (a', kind) <- kindOf a+  (b', kind') <- kindOf b+  unifyKinds kind kind'+  subst <- gets checkSubstitution+  pure ( substituteType subst kind+       , substituteType subst a'+       , substituteType subst b'+       )++-- | A successful interaction between an irreducible constraint and an inert+--  given constraint has two possible outcomes:+data Interaction+  = Simplified (SourceType, SourceType)+  -- ^ The interaction can yield a derived constraint,+  | Discharged+  -- ^ or we can learn the irreducible constraint is redundant and discharge it.++-- | Interact an irreducible constraint with an inert set of givens.+interact+  :: Environment+  -> (SourceType, SourceType)+  -> [(SourceType, SourceType, SourceType)]+  -> Maybe Interaction+interact env irred = go where+  go [] = Nothing+  go (inert : _)+    | canDischarge inert irred = Just Discharged+    | Just derived <- interactSameTyVar inert irred = Just $ Simplified derived+    | Just derived <- interactDiffTyVar env inert irred = Just $ Simplified derived+  go (_ : inerts) = go inerts++-- | A given constraint of the form @Coercible a b@ can discharge constraints+-- of the form @Coercible a b@ and @Coercible b a@.+canDischarge+  :: (SourceType, SourceType, SourceType)+  -> (SourceType, SourceType)+  -> Bool+canDischarge (_, a, b) constraint =+  (a, b) == constraint || (b, a) == constraint++-- | Two canonical constraints of the form @Coercible tv ty1@ and+-- @Coercible tv ty2@ can interact together and yield a new constraint+-- @Coercible ty1 ty2@. Canonicality matters to avoid loops.+--+-- For instance the declarations:+--+-- @+-- data D a = D a+-- newtype N a = N (D (N a))+--+-- example :: forall a. Coercible a (D a) => a -> N a+-- example = coerce+-- @+--+-- yield a non canonical wanted @Coercible a (N a)@ that we can unwrap on the+-- right to yield @Coercible a (D (N a))@. Would it interact with the non+-- canonical given @Coercible a (D a)@ it would give @Coercible (D a) (D (N a))@,+-- then decompose back to @Coercible a (N a)@.+interactSameTyVar+  :: (SourceType, SourceType, SourceType)+  -> (SourceType, SourceType)+  -> Maybe (SourceType, SourceType)+interactSameTyVar (_, tv1, ty1) (tv2, ty2)+  | tv1 == tv2 && isCanonicalTyVarEq (tv1, ty1) && isCanonicalTyVarEq (tv2, ty2)+  = Just (ty1, ty2)+  | otherwise = Nothing++-- | Two canonical constraints of the form @Coercible tv1 ty1@ and+-- @Coercible tv2 ty2@ can interact together and yield a new constraint+-- @Coercible tv2 ty2[ty1/tv1]@. Once again, canonicality matters to avoid loops.+--+-- For instance the declarations:+--+-- @+-- data D a = D a+--+-- example :: forall a b. Coercible b (D b) => a -> b+-- example = coerce+-- @+--+-- yield an irreducible canonical wanted @Coercible a b@. Would it interact with+-- the non canonical given @Coercible b (D b)@ it would give @Coercible a (D b)@,+-- which would keep interacting indefinitely with the given.+interactDiffTyVar+  :: Environment+  -> (SourceType, SourceType, SourceType)+  -> (SourceType, SourceType)+  -> Maybe (SourceType, SourceType)+interactDiffTyVar env (_, tv1, ty1) (tv2, ty2)+  | tv1 /= tv2 && isCanonicalTyVarEq (tv2, ty2)+  , (ty2', Any True) <- runWriter $ rewrite env (tv1, ty1) ty2+  = Just (tv2, ty2')+  | otherwise = Nothing++-- | A canonical constraint of the form @Coercible tv1 ty1@ can rewrite the+-- right hand side of an irreducible constraint of the form @Coercible tv2 ty2@+-- by substituting @ty1@ for every occurence of @tv1@ at representational and+-- phantom role in @ty2@. Nominal occurences are left untouched.+rewrite :: Environment -> (SourceType, SourceType) -> SourceType -> Writer Any SourceType+rewrite env (Skolem _ _ _ s1 _, ty1) | not $ occurs s1 ty1 = go where+  go (Skolem _ _ _ s2 _) | s1 == s2 = tell (Any True) $> ty1+  go ty2 | (Skolem{}, _, xs) <- unapplyTypes ty2, not $ null xs =+    rewriteTyVarApp go ty2+         | (TypeConstructor _ tyName, _, _) <- unapplyTypes ty2 = do+    rewriteTyConApp go (lookupRoles env tyName) ty2+  go (KindApp sa ty k) = KindApp sa <$> go ty <*> pure k+  go (ForAll sa tv k ty scope) = ForAll sa tv k <$> go ty <*> pure scope+  go (ConstrainedType sa Constraint{..} ty) | s1 `S.notMember` foldMap skolems constraintArgs =+    ConstrainedType sa Constraint{..} <$> go ty+  go (RCons sa label ty rest) = RCons sa label <$> go ty <*> go rest+  go (KindedType sa ty k) = KindedType sa <$> go ty <*> pure k+  go ty2 = pure ty2+rewrite _ _ = pure++-- | Rewrite the head of a type application of the form @tv a_0 .. a_n@.+rewriteTyVarApp+  :: Applicative m+  => (SourceType -> m SourceType)+  -> SourceType+  -> m SourceType+rewriteTyVarApp f = go where+  go (TypeApp sa lhs rhs) =+    TypeApp sa <$> go lhs <*> pure rhs+  go (KindApp sa ty k) =+    KindApp sa <$> go ty <*> pure k+  go ty = f ty++-- | Rewrite the representational and phantom arguments of a type application+-- of the form @D a_0 .. a_n@.+rewriteTyConApp+  :: Applicative m+  => (SourceType -> m SourceType)+  -> [Role]+  -> SourceType+  -> m SourceType+rewriteTyConApp f = go where+  go (role : roles) (TypeApp sa lhs rhs) =+    TypeApp sa <$> go roles lhs <*> case role of+      Nominal -> pure rhs+      _ -> f rhs+  go roles (KindApp sa ty k) =+    KindApp sa <$> go roles ty <*> pure k+  go _ ty = pure ty++canRewrite :: Environment -> (SourceType, SourceType) -> SourceType -> Bool+canRewrite env irred = getAny . execWriter . rewrite env irred++-- | An irreducible given constraint must kick out of the inert set any+-- constraint it can rewrite when it becomes inert, otherwise solving would be+-- sensitive to the order of constraints. Wanteds cannot rewrite other wanteds+-- so this applies only to givens.+--+-- For instance the declaration:+--+-- @+-- example :: forall f g a b. Coercible a (f b) => Coercible f g => Proxy f -> a -> g b+-- example _ = coerce+-- @+--+-- yields the irreducible givens @Coercible a (f b)@ and @Coercible f g@. Would+-- we not kick out the former when adding the latter to the inert set we would+-- not be able to rewrite it to @Coercible a (g b)@ and discharge the wanted,+-- but inverting the givens would work.+kicksOut+  :: Environment+  -> (SourceType, SourceType)+  -> (SourceType, SourceType, SourceType)+  -> Either (SourceType, SourceType) (SourceType, SourceType, SourceType)+kicksOut env irred (_, tv2, ty2)+  | isCanonicalTyVarEq (tv2, ty2) && canRewrite env irred ty2+  = Left (tv2, ty2)+kicksOut _ _ inert = Right inert++-- | A constraint of the form @Coercible tv ty@ is canonical when @tv@ does not+-- occur in @ty@. Non canonical constraints do not interact to prevent loops.+isCanonicalTyVarEq :: (SourceType, SourceType) -> Bool+isCanonicalTyVarEq (Skolem _ _ _ s _, ty) = not $ occurs s ty+isCanonicalTyVarEq _ = False++occurs :: Int -> SourceType -> Bool+occurs s1 = everythingOnTypes (||) go where+  go (Skolem _ _ _ s2 _) | s1 == s2 = True+  go _ = False++skolems :: SourceType -> S.Set Int+skolems = everythingOnTypes (<>) go where+  go (Skolem _ _ _ s _) = S.singleton s+  go _ = mempty++-- | A successful canonicalization result has two possible outcomes:+data Canonicalized+  = Canonicalized (S.Set (SourceType, SourceType))+  -- ^ Canonicalization can yield a set of derived constraints,+  | Irreducible+  -- ^ or we can learn the constraint is irreducible. Irreducibility is not+  -- necessarily an error, we may make further progress by interacting with+  -- inerts.++-- | Canonicalization takes a wanted constraint and try to reduce it to a set of+-- simpler constraints whose satisfaction will imply the goal.+canon+  :: MonadError MultipleErrors m+  => MonadWriter [ErrorMessageHint] m+  => MonadState CheckState m+  => Environment+  -> Maybe [(SourceType, SourceType, SourceType)]+  -> SourceType+  -> SourceType+  -> SourceType+  -> m Canonicalized+canon env givens k a b =+  maybe (throwError $ insoluble k a b) pure <=< runMaybeT $+        canonRefl a b+    <|> canonUnsaturatedHigherKindedType env a b+    <|> canonRow a b+    -- We unwrap newtypes before trying the decomposition rules because it let+    -- us solve more constraints.+    --+    -- For instance the declarations:+    --+    -- @+    -- newtype N f a = N (f a)+    --+    -- example :: forall a b. Coercible a b => N Maybe a -> N Maybe b+    -- example = coerce+    -- @+    --+    -- yield the wanted @Coercible (N Maybe a) (N Maybe b)@ which we cannot+    -- decompose because the second parameter of @N@ is nominal. On the other+    -- hand, unwraping on both sides yields @Coercible (Maybe a) (Maybe b)@+    -- which we can then decompose to @Coercible a b@ and discharge with the+    -- given.+    <|> canonNewtypeLeft env a b+    <|> canonNewtypeRight env a b+    <|> canonDecomposition env a b+    <|> canonDecompositionFailure env k a b+    <|> canonNewtypeDecomposition env givens a b+    <|> canonNewtypeDecompositionFailure a b+    <|> canonTypeVars a b+    <|> canonTypeVarLeft a b+    <|> canonTypeVarRight a b+    <|> canonApplicationLeft a b+    <|> canonApplicationRight a b++insoluble+  :: SourceType+  -> SourceType+  -> SourceType+  -> MultipleErrors+insoluble k a b =+  errorMessage . NoInstanceFound $ srcConstraint Prim.Coercible [k] [a, b] Nothing++-- | Constraints of the form @Coercible a b@ can be solved if the two arguments+-- are the same. Since we currently don't support higher-rank arguments in+-- instance heads, term equality is a sufficient notion of "the same".+canonRefl+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonRefl a b =+  guard (a == b) $> Canonicalized mempty++-- | Constraints of the form @Coercible (T1 a_0 .. a_n) (T2 b_0 .. b_n)@, where+-- both arguments have kind @k1 -> k2@, yield a constraint+-- @Coercible (T1 a_0 .. a_n c_0 .. c_m) (T2 b_0 .. b_n c_0 .. c_m)@, where both+-- arguments are fully saturated with the same unknowns and have kind @Type@.+canonUnsaturatedHigherKindedType+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => Environment+  -> SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonUnsaturatedHigherKindedType env a b+  | (TypeConstructor _ aTyName, akapps, axs) <- unapplyTypes a+  , (ak, _) <- fromMaybe (internalError "canonUnsaturatedHigherKindedType: type lookup failed") $ M.lookup aTyName (types env)+  , (aks, _) <- unapplyKinds ak+  , length axs < length aks = do+      ak' <- lift $ do+        let (kvs, ak') = fromMaybe (internalError "canonUnsaturatedHigherKindedType: unkinded forall binder") $ completeBinderList ak+            instantiatedKinds = zipWith (\(_, (kv, _)) k -> (kv, k)) kvs akapps+        unknownKinds <- traverse (\((ss, _), (kv, k)) -> (kv,) <$> freshKindWithKind ss k) $ drop (length akapps) kvs+        pure $ replaceAllTypeVars (instantiatedKinds <> unknownKinds) ak'+      let (aks', _) = unapplyKinds ak'+      tys <- traverse freshTypeWithKind $ drop (length axs) aks'+      let a' = foldl' srcTypeApp a tys+          b' = foldl' srcTypeApp b tys+      pure . Canonicalized $ S.singleton (a', b')+  | otherwise = empty++-- | Constraints of the form+-- @Coercible ( label_0 :: a_0, .. label_n :: a_n | r ) ( label_0 :: b_0, .. label_n :: b_n | s )@+-- yield a constraint @Coercible r s@ and constraints on the types for each+-- label in both rows. Labels exclusive to one row yield a failure.+canonRow+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonRow a b+  | RCons{} <- a =+      case alignRowsWith (,) a b of+        -- We throw early when a bare unknown remains on either side after+        -- aligning the rows because we don't know how to canonicalize them yet+        -- and the unification error thrown when the rows are misaligned should+        -- not mention unknowns.+        (_, (([], u@TUnknown{}), rl2)) -> do+          k <- elaborateKind u+          throwError $ insoluble k u (rowFromList rl2)+        (_, (rl1, ([], u@TUnknown{}))) -> do+          k <- elaborateKind u+          throwError $ insoluble k (rowFromList rl1) u+        (deriveds, (([], tail1), ([], tail2))) -> do+          pure . Canonicalized . S.fromList $ (tail1, tail2) : deriveds+        (_, (rl1, rl2)) ->+          throwError . errorMessage $ TypesDoNotUnify (rowFromList rl1) (rowFromList rl2)+  | otherwise = empty++-- | Unwraping a newtype can fails in two ways:+data UnwrapNewtypeError+  = CannotUnwrapInfiniteNewtypeChain+  -- ^ The newtype might wrap an infinite newtype chain. We may think that this+  -- is already handled by the solver depth check, but failing to unwrap+  -- infinite chains of newtypes let us try other rules.+  --+  -- For instance the declarations:+  --+  -- @+  -- newtype N a = N (N a)+  -- type role N representational+  --+  -- example :: forall a b. Coercible a b => N a -> N b+  -- example = coerce+  -- @+  --+  -- yield a wanted @Coercible (N a) (N b)@ that we can decompose to+  -- @Coercible a b@ then discharge with the given if the newtype+  -- unwraping rules do not apply.+  | CannotUnwrapConstructor+  -- ^ The constructor may not be in scope or may not belong to a newtype.++-- | Unwraps a newtype and yields its underlying type with the newtype arguments+-- substituted in (e.g. @N[D/a] = D@ given @newtype N a = N a@ and @data D = D@).+unwrapNewtype+  :: MonadState CheckState m+  => MonadWriter [ErrorMessageHint] m+  => Environment+  -> SourceType+  -> m (Either UnwrapNewtypeError SourceType)+unwrapNewtype env = go (0 :: Int) where+  go n ty = runExceptT $ do+    when (n > 1000) $ throwError CannotUnwrapInfiniteNewtypeChain+    (currentModuleName, currentModuleImports) <- gets $ checkCurrentModule &&& checkCurrentModuleImports+    case unapplyTypes ty of+      (TypeConstructor _ newtypeName, _, xs)+        | Just (inScope, fromModuleName, tvs, newtypeCtorName, wrappedTy) <-+            lookupNewtypeConstructorInScope env currentModuleName currentModuleImports newtypeName+        -- We refuse to unwrap newtypes over polytypes because we don't know how+        -- to canonicalize them yet and we'd rather try to make progress with+        -- another rule.+        , isMonoType wrappedTy -> do+            when (not inScope) $ do+              tell [MissingConstructorImportForCoercible newtypeCtorName]+              throwError CannotUnwrapConstructor+            for_ fromModuleName $ flip addConstructorImportForCoercible newtypeCtorName+            let wrappedTySub = replaceAllTypeVars (zip tvs xs) wrappedTy+            ExceptT (go (n + 1) wrappedTySub) `catchError` \case+              CannotUnwrapInfiniteNewtypeChain -> throwError CannotUnwrapInfiniteNewtypeChain+              CannotUnwrapConstructor -> pure wrappedTySub+      _ -> throwError CannotUnwrapConstructor+  addConstructorImportForCoercible fromModuleName newtypeCtorName = modify $ \st ->+    st { checkConstructorImportsForCoercible = S.insert (fromModuleName, newtypeCtorName) $ checkConstructorImportsForCoercible st }++-- | Looks up a given name and, if it names a newtype, returns the names of the+-- type's parameters, the type the newtype wraps and the names of the type's+-- fields.+lookupNewtypeConstructor+  :: Environment+  -> Qualified (ProperName 'TypeName)+  -> Maybe ([Text], ProperName 'ConstructorName, SourceType)+lookupNewtypeConstructor env qualifiedNewtypeName = do+  (_, DataType Newtype tvs [(ctorName, [wrappedTy])]) <- M.lookup qualifiedNewtypeName (types env)+  pure (map (\(name, _, _) -> name) tvs, ctorName, wrappedTy)++-- | Behaves like 'lookupNewtypeConstructor' but also returns whether the+-- newtype constructor is in scope and the module from which it is imported, or+-- 'Nothing' if it is defined in the current module.+lookupNewtypeConstructorInScope+  :: Environment+  -> Maybe ModuleName+  -> [ ( SourceAnn+       , ModuleName+       , ImportDeclarationType+       , Maybe ModuleName+       , M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)+       )+     ]+  -> Qualified (ProperName 'TypeName)+  -> Maybe (Bool, Maybe ModuleName, [Text], Qualified (ProperName 'ConstructorName), SourceType)+lookupNewtypeConstructorInScope env currentModuleName currentModuleImports qualifiedNewtypeName@(Qualified newtypeModuleName newtypeName) = do+  let fromModule = find isNewtypeCtorImported currentModuleImports+      fromModuleName = (\(_, n, _, _, _) -> n) <$> fromModule+      asModuleName = (\(_, _, _, n, _) -> n) =<< fromModule+      isDefinedInCurrentModule = newtypeModuleName == currentModuleName+      isImported = isJust fromModule+      inScope = isDefinedInCurrentModule || isImported+  (tvs, ctorName, wrappedTy) <- lookupNewtypeConstructor env qualifiedNewtypeName+  pure (inScope, fromModuleName, tvs, Qualified asModuleName ctorName, wrappedTy)+  where+  isNewtypeCtorImported (_, _, importDeclType, _, exportedTypes) =+    case M.lookup newtypeName exportedTypes of+      Just ([_], _) -> case importDeclType of+        Implicit -> True+        Explicit refs -> any isNewtypeCtorRef refs+        Hiding refs -> not $ any isNewtypeCtorRef refs+      _ -> False+  isNewtypeCtorRef = \case+    TypeRef _ importedTyName Nothing -> importedTyName == newtypeName+    TypeRef _ importedTyName (Just [_]) -> importedTyName == newtypeName+    _ -> False++-- | Constraints of the form @Coercible (N a_0 .. a_n) b@ yield a constraint+-- @Coercible a b@ if unwraping the newtype yields @a@.+canonNewtypeLeft+  :: MonadState CheckState m+  => MonadWriter [ErrorMessageHint] m+  => Environment+  -> SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonNewtypeLeft env a b =+  unwrapNewtype env a >>= \case+    Left CannotUnwrapInfiniteNewtypeChain -> empty+    Left CannotUnwrapConstructor -> empty+    Right a' -> pure . Canonicalized $ S.singleton (a', b)++-- | Constraints of the form @Coercible a (N b_0 .. b_n)@ yield a constraint+-- @Coercible a b@ if unwraping the newtype yields @b@.+canonNewtypeRight+  :: MonadState CheckState m+  => MonadWriter [ErrorMessageHint] m+  => Environment+  -> SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonNewtypeRight env =+  flip $ canonNewtypeLeft env++-- | Decomposes constraints of the form @Coercible (D a_0 .. a_n) (D b_0 .. b_n)@+-- into constraints on their representational arguments, ignoring phantom+-- arguments and failing on unequal nominal arguments.+--+-- For instance given the declarations:+--+-- @+-- data D a b c = D a b+-- type role D nominal representational phantom+-- @+--+-- We can decompose @Coercible (D a b d) (D a c e)@ into @Coercible b c@, but+-- decomposing @Coercible (D a c d) (D b c d)@ would fail.+decompose+  :: MonadError MultipleErrors m+  => Environment+  -> Qualified (ProperName 'TypeName)+  -> [SourceType]+  -> [SourceType]+  -> m Canonicalized+decompose env tyName axs bxs = do+  let roles = lookupRoles env tyName+      f role ax bx = case role of+        Nominal+          -- If we had first-class equality constraints, we'd just+          -- emit one of the form @(a ~ b)@ here and let the solver+          -- recurse. Since we don't we must compare the types at+          -- this point and fail if they don't match. This likely+          -- means there are cases we should be able to handle that+          -- we currently can't, but is at least sound.+          | ax == bx ->+              pure mempty+          | otherwise ->+              throwError . errorMessage $ TypesDoNotUnify ax bx+        Representational ->+          pure $ S.singleton (ax, bx)+        Phantom ->+          pure mempty+  fmap (Canonicalized . fold) $ sequence $ zipWith3 f roles axs bxs++-- | Constraints of the form @Coercible (D a_0 .. a_n) (D b_0 .. b_n)@, where+-- @D@ is not a newtype, yield constraints on their arguments.+canonDecomposition+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => Environment+  -> SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonDecomposition env a b+  | (TypeConstructor _ aTyName, _, axs) <- unapplyTypes a+  , (TypeConstructor _ bTyName, _, bxs) <- unapplyTypes b+  , aTyName == bTyName+  , Nothing <- lookupNewtypeConstructor env aTyName =+      decompose env aTyName axs bxs+  | otherwise = empty++-- | Constraints of the form @Coercible (D1 a_0 .. a_n) (D2 b_0 .. b_n)@, where+-- @D1@ and @D2@ are different type constructors and neither of them are+-- newtypes, are insoluble.+canonDecompositionFailure+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => Environment+  -> SourceType+  -> SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonDecompositionFailure env k a b+  | (TypeConstructor _ aTyName, _, _) <- unapplyTypes a+  , (TypeConstructor _ bTyName, _, _) <- unapplyTypes b+  , aTyName /= bTyName+  , Nothing <- lookupNewtypeConstructor env aTyName+  , Nothing <- lookupNewtypeConstructor env bTyName =+      throwError $ insoluble k a b+  | otherwise = empty++-- | Wanted constraints of the form @Coercible (N a_0 .. a_n) (N b_0 .. b_n)@,+-- where @N@ is a newtype whose constructor is out of scope, yield constraints+-- on their arguments only when no given constraint can discharge them.+--+-- We cannot decompose given constraints because newtypes are not necessarily+-- injective with respect to representational equality.+--+-- For instance given the declaration:+--+-- @+-- newtype Const a b = MkConst a+-- type role Const representational representational+-- @+--+-- Decomposing a given @Coercible (Const a a) (Const a b)@ constraint to+-- @Coercible a b@ when @MkConst@ is out of scope would let us coerce arbitrary+-- types in modules where @MkConst@ is imported, because the given is easily+-- satisfied with the newtype unwraping rules.+--+-- Moreover we do not decompose wanted constraints if they could be discharged+-- by a given constraint.+--+-- For instance the declaration:+--+-- @+-- example :: forall a b. Coercible (Const a a) (Const a b) => Const a a -> Const a b+-- example = coerce+-- @+--+-- yield an irreducible given @Coercible (Const a a) (Const a b)@ when @MkConst@+-- is out of scope. Would we decompose the wanted+-- @Coercible (Const a a) (Const a b)@ to @Coercible a b@ we would not be able+-- to discharge it with the given.+canonNewtypeDecomposition+  :: MonadError MultipleErrors m+  => MonadState CheckState m+  => Environment+  -> Maybe [(SourceType, SourceType, SourceType)]+  -> SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonNewtypeDecomposition env (Just givens) a b+  | (TypeConstructor _ aTyName, _, axs) <- unapplyTypes a+  , (TypeConstructor _ bTyName, _, bxs) <- unapplyTypes b+  , aTyName == bTyName+  , Just _ <- lookupNewtypeConstructor env aTyName = do+      let givensCanDischarge = any (\given -> canDischarge given (a, b)) givens+      guard $ not givensCanDischarge+      decompose env aTyName axs bxs+canonNewtypeDecomposition _ _ _ _ = empty++-- | Constraints of the form @Coercible (N1 a_0 .. a_n) (N2 b_0 .. b_n)@, where+-- @N1@ and @N2@ are different type constructors and either of them is a+-- newtype whose constructor is out of scope, are irreducible.+canonNewtypeDecompositionFailure+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonNewtypeDecompositionFailure a b+  | (TypeConstructor{}, _, _) <- unapplyTypes a+  , (TypeConstructor{}, _, _) <- unapplyTypes b+  = pure Irreducible+  | otherwise = empty++-- | Constraints of the form @Coercible tv1 tv2@ may be irreducibles, but only+-- when the variables are lexicographically ordered. Reordering variables is+-- necessary to prevent loops.+--+-- For instance the declaration:+--+-- @+-- example :: forall a b. Coercible a b => Coercible b a => a -> b+-- example = coerce+-- @+--+-- yields the irreducible givens @Coercible a b@ and @Coercible b a@ which would+-- repeatedly kick each other out the inert set whereas reordering the latter to+-- @Coercible a b@ makes it redundant and let us discharge it.+canonTypeVars+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonTypeVars a b+  | Skolem _ tv1 _ _ _ <- a+  , Skolem _ tv2 _ _ _ <- b+  , tv2 < tv1+  = pure . Canonicalized $ S.singleton (b, a)+  | Skolem{} <- a, Skolem{} <- b+  = pure Irreducible+  | otherwise = empty++-- | Constraints of the form @Coercible tv ty@ are irreducibles.+canonTypeVarLeft+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonTypeVarLeft a _+  | Skolem{} <- a = pure Irreducible+  | otherwise = empty++-- | Constraints of the form @Coercible ty tv@ are reordered to+-- @Coercible tv ty@ to satisfy the canonicality requirement of having the type+-- variable on the left.+canonTypeVarRight+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonTypeVarRight a b+  | Skolem{} <- b = pure . Canonicalized $ S.singleton (b, a)+  | otherwise = empty++-- | Constraints of the form @Coercible (f a_0 .. a_n) b@ are irreducibles.+canonApplicationLeft+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonApplicationLeft a _+  | TypeApp{} <- a = pure Irreducible+  | otherwise = empty++-- | Constraints of the form @Coercible a (f b_0 .. b_n) b@ are irreducibles.+canonApplicationRight+  :: Monad m+  => SourceType+  -> SourceType+  -> MaybeT m Canonicalized+canonApplicationRight _ b+  | TypeApp{} <- b = pure Irreducible+  | otherwise = empty
src/Language/PureScript/TypeChecker/Kinds.hs view
@@ -1,276 +1,972 @@-{-# LANGUAGE FlexibleInstances #-}---- |--- This module implements the kind checker----module Language.PureScript.TypeChecker.Kinds-  ( kindOf-  , kindOfWithScopedVars-  , kindsOf-  , kindsOfAll-  ) where--import Prelude.Compat--import Control.Arrow (second)-import Control.Monad-import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.State--import Data.Functor (($>))-import qualified Data.Map as M-import Data.Text (Text)-import Data.Traversable (for)--import Language.PureScript.Crash-import Language.PureScript.Environment-import Language.PureScript.Errors-import Language.PureScript.Kinds-import Language.PureScript.Names-import Language.PureScript.TypeChecker.Monad-import Language.PureScript.Types---- | Generate a fresh kind variable-freshKind :: (MonadState CheckState m) => SourceAnn -> m SourceKind-freshKind ann = do-  k <- gets checkNextKind-  modify $ \st -> st { checkNextKind = k + 1 }-  return $ KUnknown ann k--freshKind' :: (MonadState CheckState m) => m SourceKind-freshKind' = freshKind NullSourceAnn---- | Update the substitution to solve a kind constraint-solveKind-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => Int-  -> SourceKind-  -> m ()-solveKind u k = do-  occursCheck u k-  modify $ \cs -> cs { checkSubstitution =-                         (checkSubstitution cs) { substKind =-                                                    M.insert u k $ substKind $ checkSubstitution cs-                                                }-                     }---- | Apply a substitution to a kind-substituteKind :: Substitution -> SourceKind -> SourceKind-substituteKind sub = everywhereOnKinds go-  where-  go (KUnknown ann u) =-    case M.lookup u (substKind sub) of-      Nothing -> KUnknown ann u-      Just (KUnknown ann' u1) | u1 == u -> KUnknown ann' u1-      Just t -> substituteKind sub t-  go other = other---- | Make sure that an unknown does not occur in a kind-occursCheck-  :: (MonadError MultipleErrors m)-  => Int-  -> SourceKind-  -> m ()-occursCheck _ KUnknown{} = return ()-occursCheck u k = void $ everywhereOnKindsM go k-  where-  go (KUnknown _ u') | u == u' = throwError . errorMessage . InfiniteKind $ k-  go other = return other---- | Unify two kinds-unifyKinds-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => SourceKind-  -> SourceKind-  -> m ()-unifyKinds k1 k2 = do-  sub <- gets checkSubstitution-  go (substituteKind sub k1) (substituteKind sub k2)-  where-  go (KUnknown _ u1) (KUnknown _ u2) | u1 == u2 = return ()-  go (KUnknown _ u) k = solveKind u k-  go k (KUnknown _ u) = solveKind u k-  go (NamedKind _ k1') (NamedKind _ k2') | k1' == k2' = return ()-  go (Row _ k1') (Row _ k2') = unifyKinds k1' k2'-  go (FunKind _ k1' k2') (FunKind _ k3 k4) = do-    unifyKinds k1' k3-    unifyKinds k2' k4-  go k1' k2' =-    throwError-      . errorMessage''' (fst . getAnnForKind <$> [k1', k2'])-      $ KindsDoNotUnify k1' k2'---- | Infer the kind of a single type-kindOf-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => SourceType-  -> m SourceKind-kindOf ty = fst <$> kindOfWithScopedVars ty---- | Infer the kind of a single type, returning the kinds of any scoped type variables-kindOfWithScopedVars ::-  (MonadError MultipleErrors m, MonadState CheckState m) =>-  SourceType ->-  m (SourceKind, [(Text, SourceKind)])-kindOfWithScopedVars ty =-  withErrorMessageHint (ErrorCheckingKind ty) $-    fmap tidyUp . withFreshSubstitution . captureSubstitution $ infer ty-  where-  tidyUp ((k, args), sub) = ( starIfUnknown (substituteKind sub k)-                            , map (second (starIfUnknown . substituteKind sub)) args-                            )---- | Infer the kind of a type constructor with a collection of arguments and a collection of associated data constructors-kindsOf-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => Bool-  -> ModuleName-  -> ProperName 'TypeName-  -> [(Text, Maybe SourceKind)]-  -> [SourceType]-  -> m SourceKind-kindsOf isData moduleName name args ts = fmap tidyUp . withFreshSubstitution . captureSubstitution $ do-  tyCon <- freshKind'-  kargs <- replicateM (length args) $ freshKind'-  rest <- zipWithM freshKindVar args kargs-  let dict = (name, tyCon) : rest-  bindLocalTypeVariables moduleName dict $-    solveTypes isData ts kargs tyCon-  where-  tidyUp (k, sub) = starIfUnknown $ substituteKind sub k--freshKindVar-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => (Text, Maybe SourceKind)-  -> SourceKind-  -> m (ProperName 'TypeName, SourceKind)-freshKindVar (arg, Nothing) kind = return (ProperName arg, kind)-freshKindVar (arg, Just kind') kind = do-  unifyKinds kind kind'-  return (ProperName arg, kind')---- | Simultaneously infer the kinds of several mutually recursive type constructors-kindsOfAll-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => ModuleName-  -> [(SourceAnn, ProperName 'TypeName, [(Text, Maybe SourceKind)], SourceType)]-  -> [(SourceAnn, ProperName 'TypeName, [(Text, Maybe SourceKind)], [SourceType])]-  -> m ([SourceKind], [SourceKind])-kindsOfAll moduleName syns tys = fmap tidyUp . withFreshSubstitution . captureSubstitution $ do-  synVars <- for syns $ \(sa, _, _, _) -> freshKind sa-  let dict = zipWith (\(_, name, _, _) var -> (name, var)) syns synVars-  bindLocalTypeVariables moduleName dict $ do-    tyCons <- for tys $ \(sa, _, _, _) -> freshKind sa-    let dict' = zipWith (\(_, name, _, _) tyCon -> (name, tyCon)) tys tyCons-    bindLocalTypeVariables moduleName dict' $ do-      data_ks <- zipWithM (\tyCon (_, _, args, ts) -> do-        kargs <- for args $ \(_, kind) -> maybe freshKind' (freshKind . getAnnForKind) kind-        argDict <- zipWithM freshKindVar args kargs-        bindLocalTypeVariables moduleName argDict $-          solveTypes True ts kargs tyCon) tyCons tys-      syn_ks <- zipWithM (\synVar (_, _, args, ty) -> do-        kargs <- for args $ \(_, kind) -> maybe freshKind' (freshKind . getAnnForKind) kind-        argDict <- zipWithM freshKindVar args kargs-        bindLocalTypeVariables moduleName argDict $-          solveTypes False [ty] kargs synVar) synVars syns-      return (syn_ks, data_ks)-  where-  tidyUp ((ks1, ks2), sub) = (map (starIfUnknown . substituteKind sub) ks1, map (starIfUnknown . substituteKind sub) ks2)---- | Solve the set of kind constraints associated with the data constructors for a type constructor-solveTypes-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => Bool-  -> [SourceType]-  -> [SourceKind]-  -> SourceKind-  -> m SourceKind-solveTypes isData ts kargs tyCon = do-  ks <- traverse (fmap fst . infer) ts-  when isData $ do-    unifyKinds tyCon (foldr srcFunKind kindType kargs)-    forM_ ks $ \k -> unifyKinds k (kindType $> getAnnForKind k)-  unless isData $-    unifyKinds tyCon (foldr srcFunKind (head ks) kargs)-  return tyCon---- | Default all unknown kinds to the kindType kind of types-starIfUnknown :: Kind a -> Kind a-starIfUnknown (KUnknown ann _) = kindType $> ann-starIfUnknown (Row ann k) = Row ann (starIfUnknown k)-starIfUnknown (FunKind ann k1 k2) = FunKind ann (starIfUnknown k1) (starIfUnknown k2)-starIfUnknown k = k---- | Infer a kind for a type-infer-  :: (MonadError MultipleErrors m, MonadState CheckState m)-  => SourceType-  -> m (SourceKind, [(Text, SourceKind)])-infer ty =-  withErrorMessageHint (ErrorCheckingKind ty)-    . rethrowWithPosition (fst $ getAnnForType ty)-    $ infer' ty--infer'-  :: forall m-   . (MonadError MultipleErrors m, MonadState CheckState m)-  => SourceType-  -> m (SourceKind, [(Text, SourceKind)])-infer' (ForAll ann ident mbK ty _) = do-  k1 <- maybe (freshKind ann) pure mbK-  moduleName <- unsafeCheckCurrentModule-  (k2, args) <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ infer ty-  unifyKinds k2 kindType-  return (kindType, (ident, k1) : args)-infer' (KindedType _ ty k) = do-  (k', args) <- infer ty-  unifyKinds k k'-  return (k', args)-infer' other = (, []) <$> go other-  where-  go :: SourceType -> m SourceKind-  go (ForAll ann ident mbK ty _) = do-    k1 <- maybe (freshKind ann) pure mbK-    moduleName <- unsafeCheckCurrentModule-    k2 <- bindLocalTypeVariables moduleName [(ProperName ident, k1)] $ go ty-    unifyKinds k2 kindType-    return $ kindType $> ann-  go (KindedType _ ty k) = do-    k' <- go ty-    unifyKinds k k'-    return k'-  go (TypeWildcard ann _) = freshKind ann-  go (TUnknown ann _) = freshKind ann-  go (TypeLevelString ann _) = return $ kindSymbol $> ann-  go (TypeVar ann v) = do-    moduleName <- unsafeCheckCurrentModule-    ($> ann) <$> lookupTypeVariable moduleName (Qualified Nothing (ProperName v))-  go (Skolem ann v _ _) = do-    moduleName <- unsafeCheckCurrentModule-    ($> ann) <$> lookupTypeVariable moduleName (Qualified Nothing (ProperName v))-  go (TypeConstructor ann v) = do-    env <- getEnv-    case M.lookup v (types env) of-      Nothing -> throwError . errorMessage' (fst ann) . UnknownName $ fmap TyName v-      Just (kind, _) -> return $ kind $> ann-  go (TypeApp ann t1 t2) = do-    k0 <- freshKind ann-    k1 <- go t1-    k2 <- go t2-    unifyKinds k1 (FunKind ann k2 k0)-    return k0-  go (REmpty ann) = do-    k <- freshKind ann-    return $ Row ann k-  go (RCons ann _ ty row) = do-    k1 <- go ty-    k2 <- go row-    unifyKinds k2 (Row ann k1)-    return $ Row ann k1-  go (ConstrainedType ann2 (Constraint ann1 className tys _) ty) = do-    k1 <- go $ foldl (TypeApp ann2) (TypeConstructor ann1 (fmap coerceProperName className)) tys-    unifyKinds k1 kindType-    k2 <- go ty-    unifyKinds k2 kindType-    return $ kindType $> ann2-  go ty = internalError $ "Invalid argument to infer: " ++ show ty+-- |+-- This module implements the kind checker+--+module Language.PureScript.TypeChecker.Kinds+  ( kindOf+  , kindOfWithUnknowns+  , kindOfWithScopedVars+  , kindOfData+  , kindOfTypeSynonym+  , kindOfClass+  , kindsOfAll+  , unifyKinds+  , subsumesKind+  , instantiateKind+  , checkKind+  , inferKind+  , elaborateKind+  , checkConstraint+  , checkInstanceDeclaration+  , checkKindDeclaration+  , checkTypeKind+  , unknownsWithKinds+  , freshKind+  , freshKindWithKind+  ) where++import Prelude.Compat++import Control.Arrow ((***))+import Control.Monad+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.State+import Control.Monad.Supply.Class++import Data.Bifunctor (first)+import Data.Bitraversable (bitraverse)+import Data.Foldable (for_, traverse_)+import Data.Function (on)+import Data.Functor (($>))+import qualified Data.IntSet as IS+import Data.List (nubBy, sortBy, (\\))+import qualified Data.Map as M+import Data.Maybe (fromJust)+import Data.Ord (comparing)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Traversable (for)++import Language.PureScript.Crash+import qualified Language.PureScript.Environment as E+import Language.PureScript.Errors+import Language.PureScript.Names+import Language.PureScript.TypeChecker.Monad+import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, newSkolemScope, skolemize)+import Language.PureScript.TypeChecker.Synonyms+import Language.PureScript.Types+import Language.PureScript.Pretty.Types+import Lens.Micro.Platform ((^.), _1, _2, _3)++generalizeUnknowns :: [(Unknown, SourceType)] -> SourceType -> SourceType+generalizeUnknowns unks ty =+  generalizeUnknownsWithVars (unknownVarNames (usedTypeVariables ty) unks) ty++generalizeUnknownsWithVars :: [(Unknown, (Text, SourceType))] -> SourceType -> SourceType+generalizeUnknownsWithVars binders ty =+  mkForAll ((getAnnForType ty,) . fmap (Just . replaceUnknownsWithVars binders) . snd <$> binders) . replaceUnknownsWithVars binders $ ty++replaceUnknownsWithVars :: [(Unknown, (Text, a))] -> SourceType -> SourceType+replaceUnknownsWithVars binders ty+  | null binders = ty+  | otherwise = go ty+  where+  go :: SourceType -> SourceType+  go = everywhereOnTypes $ \case+    TUnknown ann unk | Just (name, _) <- lookup unk binders -> TypeVar ann name+    other -> other++unknownVarNames :: [Text] -> [(Unknown, SourceType)] -> [(Unknown, (Text, SourceType))]+unknownVarNames used unks =+  zipWith (\(a, b) n -> (a, (n, b))) unks $ allVars \\ used+  where+  allVars :: [Text]+  allVars+    | [_] <- unks = "k" : vars+    | otherwise = vars++  vars :: [Text]+  vars = fmap (("k" <>) . T.pack . show) ([1..] :: [Int])++apply :: (MonadState CheckState m) => SourceType -> m SourceType+apply ty = flip substituteType ty <$> gets checkSubstitution++substituteType :: Substitution -> SourceType -> SourceType+substituteType sub = everywhereOnTypes $ \case+  TUnknown ann u ->+    case M.lookup u (substType sub) of+      Nothing -> TUnknown ann u+      Just (TUnknown ann' u1) | u1 == u -> TUnknown ann' u1+      Just t -> substituteType sub t+  other ->+    other++freshUnknown :: (MonadState CheckState m) => m Unknown+freshUnknown = do+  k <- gets checkNextType+  modify $ \st -> st { checkNextType = k + 1 }+  pure k++freshKind :: (MonadState CheckState m) => SourceSpan -> m SourceType+freshKind ss = freshKindWithKind ss E.kindType++freshKindWithKind :: (MonadState CheckState m) => SourceSpan -> SourceType -> m SourceType+freshKindWithKind ss kind = do+  u <- freshUnknown+  addUnsolved Nothing u kind+  pure $ TUnknown (ss, []) u++addUnsolved :: (MonadState CheckState m) => Maybe UnkLevel -> Unknown -> SourceType -> m ()+addUnsolved lvl unk kind = modify $ \st -> do+  let+    newLvl = UnkLevel $ case lvl of+      Nothing -> pure unk+      Just (UnkLevel lvl') -> lvl' <> pure unk+    subs = checkSubstitution st+    uns = M.insert unk (newLvl, kind) $ substUnsolved subs+  st { checkSubstitution = subs { substUnsolved = uns } }++solve :: (MonadState CheckState m) => Unknown -> SourceType -> m ()+solve unk solution = modify $ \st -> do+  let+    subs = checkSubstitution st+    tys = M.insert unk solution $ substType subs+  st { checkSubstitution = subs { substType = tys } }++lookupUnsolved+  :: (MonadState CheckState m, MonadError MultipleErrors m, HasCallStack)+  => Unknown+  -> m (UnkLevel, SourceType)+lookupUnsolved u = do+  uns <- gets (substUnsolved . checkSubstitution)+  case M.lookup u uns of+    Nothing -> internalCompilerError $ "Unsolved unification variable ?" <> T.pack (show u) <> " is not bound"+    Just res -> return res++unknownsWithKinds+  :: forall m. (MonadState CheckState m, MonadError MultipleErrors m, HasCallStack)+  => [Unknown]+  -> m [(Unknown, SourceType)]+unknownsWithKinds = fmap (fmap snd . nubBy ((==) `on` fst) . sortBy (comparing fst) . join) . traverse go+  where+  go u = do+    (lvl, ty) <- traverse apply =<< lookupUnsolved u+    rest <- fmap join . traverse go . IS.toList . unknowns $ ty+    pure $ (lvl, (u, ty)) : rest++inferKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> m (SourceType, SourceType)+inferKind = \tyToInfer ->+  withErrorMessageHint (ErrorInferringKind tyToInfer)+    . rethrowWithPosition (fst $ getAnnForType tyToInfer)+    $ go tyToInfer+  where+  go = \case+    ty@(TypeConstructor ann v) -> do+      env <- getEnv+      case M.lookup v (E.types env) of+        Nothing ->+          throwError . errorMessage' (fst ann) . UnknownName . fmap TyName $ v+        Just (kind, E.LocalTypeVariable) -> do+          kind' <- apply kind+          pure (ty, kind' $> ann)+        Just (kind, _) -> do+          pure (ty, kind $> ann)+    ConstrainedType ann' con@(Constraint ann v _ _ _) ty -> do+      env <- getEnv+      con' <- case M.lookup (coerceProperName <$> v) (E.types env) of+        Nothing ->+          throwError . errorMessage' (fst ann) . UnknownName . fmap TyClassName $ v+        Just _ ->+          checkConstraint con+      ty' <- checkKind ty E.kindType+      con'' <- applyConstraint con'+      pure (ConstrainedType ann' con'' ty', E.kindType $> ann')+    ty@(TypeLevelString ann _) ->+      pure (ty, E.kindSymbol $> ann)+    ty@(TypeVar ann v) -> do+      moduleName <- unsafeCheckCurrentModule+      kind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing $ ProperName v)+      pure (ty, kind $> ann)+    ty@(Skolem ann _ mbK _ _) -> do+      kind <- apply $ maybe (internalError "Skolem has no kind") id mbK+      pure (ty, kind $> ann)+    ty@(TUnknown ann u) -> do+      kind <- apply . snd =<< lookupUnsolved u+      pure (ty, kind $> ann)+    ty@(TypeWildcard ann _) -> do+      k <- freshKind (fst ann)+      pure (ty, k $> ann)+    ty@(REmpty ann) -> do+      pure (ty, E.kindOfREmpty $> ann)+    ty@(RCons ann _ _ _) | (rowList, rowTail) <- rowToList ty -> do+      kr <- freshKind (fst ann)+      rowList' <- for rowList $ \(RowListItem a lbl t) ->+        RowListItem a lbl <$> checkKind t kr+      rowTail' <- checkKind rowTail $ E.kindRow kr+      kr' <- apply kr+      pure (rowFromList (rowList', rowTail'), E.kindRow kr' $> ann)+    TypeApp ann t1 t2 -> do+      (t1', k1) <- go t1+      inferAppKind ann (t1', k1) t2+    KindApp ann t1 t2 -> do+      (t1', kind) <- bitraverse pure apply =<< go t1+      case kind of+        ForAll _ arg (Just argKind) resKind _ -> do+          t2' <- checkKind t2 argKind+          pure (KindApp ann t1' t2', replaceTypeVars arg t2' resKind)+        _ ->+          internalError $ "inferKind: unkinded forall binder"+    KindedType _ t1 t2 -> do+      t2' <- replaceAllTypeSynonyms . fst =<< go t2+      t1' <- checkKind t1 t2'+      t2'' <- apply t2'+      pure (t1', t2'')+    ForAll ann arg mbKind ty sc -> do+      moduleName <- unsafeCheckCurrentModule+      kind <- case mbKind of+        Just k -> replaceAllTypeSynonyms =<< checkKind k E.kindType+        Nothing -> freshKind (fst ann)+      (ty', unks) <- bindLocalTypeVariables moduleName [(ProperName arg, kind)] $ do+        ty' <- apply =<< checkKind ty E.kindType+        unks <- unknownsWithKinds . IS.toList $ unknowns ty'+        pure (ty', unks)+      for_ unks . uncurry $ addUnsolved Nothing+      pure (ForAll ann arg (Just kind) ty' sc, E.kindType $> ann)+    ParensInType _ ty ->+      go ty+    ty ->+      internalError $ "inferKind: Unimplemented case \n" <> prettyPrintType 100 ty++inferAppKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceAnn+  -> (SourceType, SourceType)+  -> SourceType+  -> m (SourceType, SourceType)+inferAppKind ann (fn, fnKind) arg = case fnKind of+  TypeApp _ (TypeApp _ arrKind argKind) resKind | eqType arrKind E.tyFunction -> do+    arg' <- checkKind arg argKind+    (TypeApp ann fn arg',) <$> apply resKind+  TUnknown _ u -> do+    (lvl, _) <- lookupUnsolved u+    u1 <- freshUnknown+    u2 <- freshUnknown+    addUnsolved (Just lvl) u1 E.kindType+    addUnsolved (Just lvl) u2 E.kindType+    solve u $ (TUnknown ann u1 E.-:> TUnknown ann u2) $> ann+    arg' <- checkKind arg $ TUnknown ann u1+    pure (TypeApp ann fn arg', TUnknown ann u2)+  ForAll _ a (Just k) ty _ -> do+    u <- freshUnknown+    addUnsolved Nothing u k+    inferAppKind ann (KindApp ann fn (TUnknown ann u), replaceTypeVars a (TUnknown ann u) ty) arg+  _ ->+    cannotApplyTypeToType fn arg++cannotApplyTypeToType+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> SourceType+  -> m a+cannotApplyTypeToType fn arg = do+  argKind <- snd <$> inferKind arg+  _ <- checkKind fn . srcTypeApp (srcTypeApp E.tyFunction argKind) =<< freshKind nullSourceSpan+  internalCompilerError . T.pack $ "Cannot apply type to type: " <> debugType (srcTypeApp fn arg)++cannotApplyKindToType+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> SourceType+  -> m a+cannotApplyKindToType poly arg = do+  let ann = getAnnForType arg+  argKind <- snd <$> inferKind arg+  _ <- checkKind poly . mkForAll [(ann, ("k", Just argKind))] =<< freshKind nullSourceSpan+  internalCompilerError . T.pack $ "Cannot apply kind to type: " <> debugType (srcKindApp poly arg)++checkKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> SourceType+  -> m SourceType+checkKind ty kind2 =+  withErrorMessageHint (ErrorCheckingKind ty kind2)+    . rethrowWithPosition (fst $ getAnnForType ty) $ do+        (ty', kind1) <- inferKind ty+        kind1' <- apply kind1+        kind2' <- apply kind2+        instantiateKind (ty', kind1') kind2'++instantiateKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => (SourceType, SourceType)+  -> SourceType+  -> m SourceType+instantiateKind (ty, kind1) kind2 = case kind1 of+  ForAll _ a (Just k) t _ | shouldInstantiate kind2 -> do+    let ann = getAnnForType ty+    u <- freshKindWithKind (fst ann) k+    instantiateKind (KindApp ann ty u, replaceTypeVars a u t) kind2+  _ -> do+    subsumesKind kind1 kind2+    pure ty+  where+  shouldInstantiate = not . \case+    ForAll _ _ _ _ _ -> True+    _ -> False++subsumesKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> SourceType+  -> m ()+subsumesKind = go+  where+  go = curry $ \case+    (TypeApp _ (TypeApp _ arr1 a1) a2, TypeApp _ (TypeApp _ arr2 b1) b2)+      | eqType arr1 E.tyFunction+      , eqType arr2 E.tyFunction -> do+          go b1 a1+          join $ go <$> apply a2 <*> apply b2+    (a, ForAll ann var mbKind b mbScope) -> do+      scope <- maybe newSkolemScope pure mbScope+      skolc <- newSkolemConstant+      go a $ skolemize ann var mbKind skolc scope b+    (ForAll ann var (Just kind) a _, b) -> do+      a' <- freshKindWithKind (fst ann) kind+      go (replaceTypeVars var a' a) b+    (TUnknown ann u, b@(TypeApp _ (TypeApp _ arr _) _))+      | eqType arr E.tyFunction+      , IS.notMember u (unknowns b) ->+          join $ go <$> solveUnknownAsFunction ann u <*> pure b+    (a@(TypeApp _ (TypeApp _ arr _) _), TUnknown ann u)+      | eqType arr E.tyFunction+      , IS.notMember u (unknowns a) ->+          join $ go <$> pure a <*> solveUnknownAsFunction ann u+    (a, b) ->+      unifyKinds a b++unifyKinds+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> SourceType+  -> m ()+unifyKinds = unifyKindsWithFailure $ \w1 w2 ->+  throwError+    . errorMessage''' (fst . getAnnForType <$> [w1, w2])+    $ KindsDoNotUnify w1 w2++-- | Check the kind of a type, failing if it is not of kind *.+checkTypeKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> SourceType+  -> m ()+checkTypeKind ty kind =+  unifyKindsWithFailure (\_ _ -> throwError . errorMessage $ ExpectedType ty kind) kind E.kindType++unifyKindsWithFailure+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => (SourceType -> SourceType -> m ())+  -> SourceType+  -> SourceType+  -> m ()+unifyKindsWithFailure onFailure = go+  where+  go = curry $ \case+    (TypeApp _ p1 p2, TypeApp _ p3 p4) -> do+      go p1 p3+      join $ go <$> apply p2 <*> apply p4+    (KindApp _ p1 p2, KindApp _ p3 p4) -> do+      go p1 p3+      join $ go <$> apply p2 <*> apply p4+    (r1@(RCons _ _ _ _), r2) ->+      unifyRows r1 r2+    (r1, r2@(RCons _ _ _ _)) ->+      unifyRows r1 r2+    (r1@(REmpty _), r2) ->+      unifyRows r1 r2+    (r1, r2@(REmpty _)) ->+      unifyRows r1 r2+    (w1, w2) | eqType w1 w2 ->+      pure ()+    (TUnknown _ a', p1) ->+      solveUnknown a' p1+    (p1, TUnknown _ a') ->+      solveUnknown a' p1+    (w1, w2) ->+      onFailure w1 w2++  unifyRows r1 r2 = do+    let (matches, rest) = alignRowsWith go r1 r2+    sequence_ matches+    unifyTails rest++  unifyTails = \case+    (([], TUnknown _ a'), (rs, p1)) ->+      solveUnknown a' $ rowFromList (rs, p1)+    ((rs, p1), ([], TUnknown _ a')) ->+      solveUnknown a' $ rowFromList (rs, p1)+    (([], w1), ([], w2)) | eqType w1 w2 ->+      pure ()+    ((rs1, TUnknown _ u1), (rs2, TUnknown _ u2)) -> do+      rest <- freshKind nullSourceSpan+      solveUnknown u1 $ rowFromList (rs2, rest)+      solveUnknown u2 $ rowFromList (rs1, rest)+    (w1, w2) ->+      onFailure (rowFromList w1) (rowFromList w2)++solveUnknown+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => Unknown+  -> SourceType+  -> m ()+solveUnknown a' p1 = do+  p2 <- promoteKind a' p1+  w1 <- snd <$> lookupUnsolved a'+  join $ unifyKinds <$> apply w1 <*> elaborateKind p2+  solve a' p2++solveUnknownAsFunction+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceAnn+  -> Unknown+  -> m SourceType+solveUnknownAsFunction ann u = do+  lvl <- fst <$> lookupUnsolved u+  u1 <- freshUnknown+  u2 <- freshUnknown+  addUnsolved (Just lvl) u1 E.kindType+  addUnsolved (Just lvl) u2 E.kindType+  let uarr = (TUnknown ann u1 E.-:> TUnknown ann u2) $> ann+  solve u uarr+  pure uarr++promoteKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => Unknown+  -> SourceType+  -> m SourceType+promoteKind u2 ty = do+  lvl2 <- fst <$> lookupUnsolved u2+  flip everywhereOnTypesM ty $ \case+    ty'@(TUnknown ann u1) -> do+      when (u1 == u2) . throwError . errorMessage . InfiniteKind $ ty+      (lvl1, k) <- lookupUnsolved u1+      if lvl1 < lvl2 then+        pure ty'+      else do+        k'  <- promoteKind u2 =<< apply k+        u1' <- freshUnknown+        addUnsolved (Just lvl2) u1' k'+        solve u1 $ TUnknown ann u1'+        pure $ TUnknown ann u1'+    ty' ->+      pure ty'++elaborateKind+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> m SourceType+elaborateKind = \case+  TypeLevelString ann _ ->+    pure $ E.kindSymbol $> ann+  TypeConstructor ann v -> do+    env <- getEnv+    case M.lookup v (E.types env) of+      Nothing ->+        throwError . errorMessage' (fst ann) . UnknownName . fmap TyName $ v+      Just (kind, _) ->+        ($> ann) <$> apply kind+  TypeVar ann a -> do+    moduleName <- unsafeCheckCurrentModule+    kind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing $ ProperName a)+    pure (kind $> ann)+  (Skolem ann _ mbK _ _) -> do+    kind <- apply $ maybe (internalError "Skolem has no kind") id mbK+    pure $ kind $> ann+  TUnknown ann a' -> do+    kind <- snd <$> lookupUnsolved a'+    ($> ann) <$> apply kind+  REmpty ann -> do+    pure $ E.kindOfREmpty $> ann+  RCons ann _ t1 _ -> do+    k1 <- elaborateKind t1+    pure $ E.kindRow k1 $> ann+  ty@(TypeApp ann t1 t2) -> do+    k1 <- elaborateKind t1+    case k1 of+      TypeApp _ (TypeApp _ k _) w2 | eqType k E.tyFunction -> do+        pure $ w2 $> ann+      -- Normally we wouldn't unify in `elaborateKind`, since an unknown should+      -- always have a known kind. However, since type holes are fully inference+      -- driven, they are unknowns with unknown kinds, which may require some+      -- late unification here.+      TUnknown a u -> do+        _ <- solveUnknownAsFunction a u+        elaborateKind ty+      _ ->+        cannotApplyTypeToType t1 t2+  KindApp ann t1 t2 -> do+    k1 <- elaborateKind t1+    case k1 of+      ForAll _ a _ n _ -> do+        flip (replaceTypeVars a) n . ($> ann) <$> apply t2+      _ ->+        cannotApplyKindToType t1 t2+  ForAll ann _ _ _ _ -> do+    pure $ E.kindType $> ann+  ConstrainedType ann _ _ ->+    pure $ E.kindType $> ann+  KindedType ann _ k ->+    pure $ k $> ann+  ty ->+    throwError . errorMessage' (fst (getAnnForType ty)) $ UnsupportedTypeInKind ty++checkEscapedSkolems :: MonadError MultipleErrors m => SourceType -> m ()+checkEscapedSkolems ty =+  traverse_ (throwError . toSkolemError)+    . everythingWithContextOnTypes ty [] (<>) go+    $ ty+  where+  go :: SourceType -> SourceType -> (SourceType, [(SourceSpan, Text, SourceType)])+  go ty' = \case+    Skolem ss name _ _ _ -> (ty', [(fst ss, name, ty')])+    ty''@(KindApp _ _ _) -> (ty'', [])+    _ -> (ty', [])++  toSkolemError (ss, name, ty') =+    errorMessage' (fst $ getAnnForType ty') $ EscapedSkolem name (Just ss) ty'++kindOfWithUnknowns+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> m (([(Unknown, SourceType)], SourceType), SourceType)+kindOfWithUnknowns ty = do+  (ty', kind) <- kindOf ty+  unks <- unknownsWithKinds . IS.toList $ unknowns ty'+  pure ((unks, ty'), kind)++-- | Infer the kind of a single type+kindOf+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> m (SourceType, SourceType)+kindOf = fmap (first snd) . kindOfWithScopedVars++-- | Infer the kind of a single type, returning the kinds of any scoped type variables+kindOfWithScopedVars+  :: (MonadError MultipleErrors m, MonadState CheckState m, HasCallStack)+  => SourceType+  -> m (([(Text, SourceType)], SourceType), SourceType)+kindOfWithScopedVars ty = do+  (ty', kind) <- bitraverse apply (replaceAllTypeSynonyms <=< apply) =<< inferKind ty+  let binders = fst . fromJust $ completeBinderList ty'+  pure ((snd <$> binders, ty'), kind)++type DataDeclarationArgs =+  ( SourceAnn+  , ProperName 'TypeName+  , [(Text, Maybe SourceType)]+  , [DataConstructorDeclaration]+  )++type DataDeclarationResult =+  ( [(DataConstructorDeclaration, SourceType)]+  -- ^ The infered type signatures of data constructors+  , SourceType+  -- ^ The inferred kind of the declaration+  )++kindOfData+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> DataDeclarationArgs+  -> m DataDeclarationResult+kindOfData moduleName dataDecl =+  head . (^. _2) <$> kindsOfAll moduleName [] [dataDecl] []++inferDataDeclaration+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> DataDeclarationArgs+  -> m [(DataConstructorDeclaration, SourceType)]+inferDataDeclaration moduleName (ann, tyName, tyArgs, ctors) = do+  tyKind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing tyName)+  let (sigBinders, tyKind') = fromJust . completeBinderList $ tyKind+  bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do+    tyArgs' <- for tyArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< flip checkKind E.kindType+    subsumesKind (foldr ((E.-:>) . snd) E.kindType tyArgs') tyKind'+    bindLocalTypeVariables moduleName (first ProperName <$> tyArgs') $ do+      let tyCtorName = srcTypeConstructor $ mkQualified tyName moduleName+          tyCtor = foldl (\ty -> srcKindApp ty . srcTypeVar . fst . snd) tyCtorName sigBinders+          tyCtor' = foldl (\ty -> srcTypeApp ty . srcTypeVar . fst) tyCtor tyArgs'+          ctorBinders = fmap (fmap (fmap Just)) $ sigBinders <> fmap (nullSourceAnn,) tyArgs'+      for ctors $ \ctor ->+        fmap (mkForAll ctorBinders) <$> inferDataConstructor tyCtor' ctor++inferDataConstructor+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => SourceType+  -> DataConstructorDeclaration+  -> m (DataConstructorDeclaration, SourceType)+inferDataConstructor tyCtor DataConstructorDeclaration{..} = do+  dataCtorFields' <- traverse (traverse (flip checkKind E.kindType)) dataCtorFields+  dataCtor <- flip (foldr ((E.-:>) . snd)) dataCtorFields' <$> checkKind tyCtor E.kindType+  pure ( DataConstructorDeclaration { dataCtorFields = dataCtorFields', .. }, dataCtor )++type TypeDeclarationArgs =+  ( SourceAnn+  , ProperName 'TypeName+  , [(Text, Maybe SourceType)]+  , SourceType+  )++type TypeDeclarationResult =+  ( SourceType+  -- ^ The elaborated rhs of the declaration+  , SourceType+  -- ^ The inferred kind of the declaration+  )++kindOfTypeSynonym+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> TypeDeclarationArgs+  -> m TypeDeclarationResult+kindOfTypeSynonym moduleName typeDecl =+  head . (^. _1) <$> kindsOfAll moduleName [typeDecl] [] []++inferTypeSynonym+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> TypeDeclarationArgs+  -> m SourceType+inferTypeSynonym moduleName (ann, tyName, tyArgs, tyBody) = do+  tyKind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing tyName)+  let (sigBinders, tyKind') = fromJust . completeBinderList $ tyKind+  bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do+    kindRes <- freshKind (fst ann)+    tyArgs' <- for tyArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< flip checkKind E.kindType+    unifyKinds tyKind' $ foldr ((E.-:>) . snd) kindRes tyArgs'+    bindLocalTypeVariables moduleName (first ProperName <$> tyArgs') $ do+      tyBodyAndKind <- inferKind tyBody+      instantiateKind tyBodyAndKind =<< apply kindRes++-- | Checks that a particular generalization is valid and well-scoped.+-- | Implicitly generalized kinds are always elaborated before explicitly+-- | quantified type variables. It's possible that such a kind can be+-- | inserted before other variables that it depends on, making it+-- | ill-scoped. We require that users explicitly generalize this kind+-- | in such a case.+checkQuantification+  :: forall m. (MonadError MultipleErrors m)+  => SourceType+  -> m ()+checkQuantification ty =+  collectErrors . go [] [] . fst . fromJust . completeBinderList $ ty+  where+  collectErrors vars =+    unless (null vars)+      . throwError+      . foldMap (\(ann, arg) -> errorMessage' (fst ann) $ QuantificationCheckFailureInKind arg)+      $ vars++  go acc _ [] = reverse acc+  go acc sco ((_, (arg, k)) : rest)+    | any (not . flip elem sco) $ freeTypeVariables k = goDeps acc arg rest+    | otherwise = go acc (arg : sco) rest++  goDeps acc _ [] = acc+  goDeps acc karg ((ann, (arg, k)) : rest)+    | isDep && arg == karg = (ann, arg) : acc+    | isDep = goDeps ((ann, arg) : acc) karg rest+    | otherwise = goDeps acc karg rest+    where+    isDep =+      elem karg $ freeTypeVariables k++checkVisibleTypeQuantification+  :: forall m. (MonadError MultipleErrors m)+  => SourceType+  -> m ()+checkVisibleTypeQuantification =+  collectErrors . freeTypeVariables+  where+  collectErrors vars =+    unless (null vars)+      . throwError+      . foldMap (errorMessage . VisibleQuantificationCheckFailureInType)+      $ vars++-- | Checks that there are no remaining unknowns in a type, and if so+-- | throws an error. This is necessary for contexts where we can't+-- | implicitly generalize unknowns, such as on the right-hand-side of+-- | a type synonym, or in arguments to data constructors.+checkTypeQuantification+  :: forall m. (MonadError MultipleErrors m)+  => SourceType+  -> m ()+checkTypeQuantification =+  collectErrors . everythingWithContextOnTypes True [] (<>) unknownsInKinds+  where+  collectErrors tysWithUnks =+    unless (null tysWithUnks) . throwError . foldMap toMultipleErrors $ tysWithUnks++  toMultipleErrors (ss, unks, ty) =+    errorMessage' ss $ QuantificationCheckFailureInType (IS.toList unks) ty++  unknownsInKinds False _ = (False, [])+  unknownsInKinds _ ty = case ty of+    ForAll sa _ _ _ _ | unks <- unknowns ty, not (IS.null unks) ->+      (False, [(fst sa, unks, ty)])+    KindApp sa _ _ | unks <- unknowns ty, not (IS.null unks) ->+      (False, [(fst sa, unks, ty)])+    ConstrainedType sa _ _ | unks <- unknowns ty, not (IS.null unks) ->+      (False, [(fst sa, unks, ty)])+    _ ->+      (True, [])++type ClassDeclarationArgs =+  ( SourceAnn+  , ProperName 'ClassName+  , [(Text, Maybe SourceType)]+  , [SourceConstraint]+  , [Declaration]+  )++type ClassDeclarationResult =+  ( [(Text, SourceType)]+  -- ^ The kind annotated class arguments+  , [SourceConstraint]+  -- ^ The kind annotated superclass constraints+  , [Declaration]+  -- ^ The kind annotated declarations+  , SourceType+  -- ^ The inferred kind of the declaration+  )++kindOfClass+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> ClassDeclarationArgs+  -> m ClassDeclarationResult+kindOfClass moduleName clsDecl =+  head . (^. _3) <$> kindsOfAll moduleName [] [] [clsDecl]++inferClassDeclaration+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> ClassDeclarationArgs+  -> m ([(Text, SourceType)], [SourceConstraint], [Declaration])+inferClassDeclaration moduleName (ann, clsName, clsArgs, superClasses, decls) = do+  clsKind <- apply =<< lookupTypeVariable moduleName (Qualified Nothing $ coerceProperName clsName)+  let (sigBinders, clsKind') = fromJust . completeBinderList $ clsKind+  bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do+    clsArgs' <- for clsArgs . traverse . maybe (freshKind (fst ann)) $ replaceAllTypeSynonyms <=< apply <=< flip checkKind E.kindType+    unifyKinds clsKind' $ foldr ((E.-:>) . snd) E.kindConstraint clsArgs'+    bindLocalTypeVariables moduleName (first ProperName <$> clsArgs') $ do+      (clsArgs',,)+        <$> for superClasses checkConstraint+        <*> for decls checkClassMemberDeclaration++checkClassMemberDeclaration+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => Declaration+  -> m Declaration+checkClassMemberDeclaration = \case+  TypeDeclaration (TypeDeclarationData ann ident ty) ->+    TypeDeclaration . TypeDeclarationData ann ident <$> checkKind ty E.kindType+  _ -> internalError "Invalid class member declaration"++applyClassMemberDeclaration+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => Declaration+  -> m Declaration+applyClassMemberDeclaration = \case+  TypeDeclaration (TypeDeclarationData ann ident ty) ->+    TypeDeclaration . TypeDeclarationData ann ident <$> apply ty+  _ -> internalError "Invalid class member declaration"++mapTypeDeclaration :: (SourceType -> SourceType) -> Declaration -> Declaration+mapTypeDeclaration f = \case+  TypeDeclaration (TypeDeclarationData ann ident ty) ->+    TypeDeclaration . TypeDeclarationData ann ident $ f ty+  other ->+    other++checkConstraint+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => SourceConstraint+  -> m SourceConstraint+checkConstraint (Constraint ann clsName kinds args dat) = do+  let ty = foldl (TypeApp ann) (foldl (KindApp ann) (TypeConstructor ann (fmap coerceProperName clsName)) kinds) args+  (_, kinds', args') <- unapplyTypes <$> checkKind ty E.kindConstraint+  pure $ Constraint ann clsName kinds' args' dat++applyConstraint+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => SourceConstraint+  -> m SourceConstraint+applyConstraint (Constraint ann clsName kinds args dat) = do+  let ty = foldl (TypeApp ann) (foldl (KindApp ann) (TypeConstructor ann (fmap coerceProperName clsName)) kinds) args+  (_, kinds', args') <- unapplyTypes <$> apply ty+  pure $ Constraint ann clsName kinds' args' dat++type InstanceDeclarationArgs =+  ( SourceAnn+  , [SourceConstraint]+  , Qualified (ProperName 'ClassName)+  , [SourceType]+  )++type InstanceDeclarationResult =+  ( [SourceConstraint]+  , [SourceType]+  , [SourceType]+  , [(Text, SourceType)]+  )++checkInstanceDeclaration+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> InstanceDeclarationArgs+  -> m InstanceDeclarationResult+checkInstanceDeclaration moduleName (ann, constraints, clsName, args) = do+  let ty = foldl (TypeApp ann) (TypeConstructor ann (fmap coerceProperName clsName)) args+      tyWithConstraints = foldr srcConstrainedType ty constraints+      freeVars = freeTypeVariables tyWithConstraints+  freeVarsDict <- for freeVars $ \v -> (ProperName v,) <$> freshKind (fst ann)+  bindLocalTypeVariables moduleName freeVarsDict $ do+    ty' <- checkKind ty E.kindConstraint+    constraints' <- for constraints checkConstraint+    allTy <- apply $ foldr srcConstrainedType ty' constraints'+    allUnknowns <- unknownsWithKinds . IS.toList $ unknowns allTy+    let unknownVars = unknownVarNames (usedTypeVariables allTy) allUnknowns+    let allWithVars = replaceUnknownsWithVars unknownVars allTy+    let (allConstraints, (_, allKinds, allArgs)) = unapplyTypes <$> unapplyConstraints allWithVars+    varKinds <- traverse (traverse (fmap (replaceUnknownsWithVars unknownVars) . apply)) $ (snd <$> unknownVars) <> (first runProperName <$> freeVarsDict)+    pure (allConstraints, allKinds, allArgs, varKinds)++checkKindDeclaration+  :: forall m. (MonadSupply m, MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> SourceType+  -> m SourceType+checkKindDeclaration _ ty = do+  (ty', kind) <- kindOf ty+  checkTypeKind kind E.kindType+  ty'' <- replaceAllTypeSynonyms ty'+  unks <- unknownsWithKinds . IS.toList $ unknowns ty''+  finalTy <- generalizeUnknowns unks <$> freshenForAlls ty' ty''+  checkQuantification finalTy+  checkValidKind finalTy+  where+  -- When expanding type synoyms and generalizing, we need to generate more+  -- unique names so that they don't clash or shadow other names, or can+  -- be referenced (easily).+  freshVar arg = (arg <>) . T.pack . show <$> fresh+  freshenForAlls = curry $ \case+    (ForAll _ v1 _ ty1 _, ForAll a2 v2 k2 ty2 sc2) | v1 == v2 -> do+      ty2' <- freshenForAlls ty1 ty2+      pure $ ForAll a2 v2 k2 ty2' sc2+    (_, ty2) -> go ty2 where+      go = \case+        ForAll a' v' k' ty' sc' -> do+          v'' <- freshVar v'+          ty'' <- go (replaceTypeVars v' (TypeVar a' v'') ty')+          pure $ ForAll a' v'' k' ty'' sc'+        other -> pure other++  checkValidKind = everywhereOnTypesM $ \case+    ty'@(ConstrainedType ann _ _) ->+      throwError . errorMessage' (fst ann) $ UnsupportedTypeInKind ty'+    other -> pure other++existingSignatureOrFreshKind+  :: forall m. MonadState CheckState m+  => ModuleName+  -> SourceSpan+  -> ProperName 'TypeName+  -> m SourceType+existingSignatureOrFreshKind moduleName ss name = do+  env <- getEnv+  case M.lookup (Qualified (Just moduleName) name) (E.types env) of+    Nothing -> freshKind ss+    Just (kind, _) -> pure kind++kindsOfAll+  :: forall m. (MonadError MultipleErrors m, MonadState CheckState m)+  => ModuleName+  -> [TypeDeclarationArgs]+  -> [DataDeclarationArgs]+  -> [ClassDeclarationArgs]+  -> m ([TypeDeclarationResult], [DataDeclarationResult], [ClassDeclarationResult])+kindsOfAll moduleName syns dats clss = withFreshSubstitution $ do+  synDict <- for syns $ \(sa, synName, _, _) -> fmap (synName,) $ existingSignatureOrFreshKind moduleName (fst sa) synName+  datDict <- for dats $ \(sa, datName, _, _) -> fmap (datName,) $ existingSignatureOrFreshKind moduleName (fst sa) datName+  clsDict <- for clss $ \(sa, clsName, _, _, _) -> fmap (coerceProperName clsName,) $ existingSignatureOrFreshKind moduleName (fst sa) $ coerceProperName clsName+  let bindingGroup = synDict <> datDict <> clsDict+  bindLocalTypeVariables moduleName bindingGroup $ do+    synResults <- for syns (inferTypeSynonym moduleName)+    datResults <- for dats (inferDataDeclaration moduleName)+    clsResults <- for clss (inferClassDeclaration moduleName)+    synResultsWithUnks <- for (zip synDict synResults) $ \((synName, synKind), synBody) -> do+      synKind' <- apply synKind+      synBody' <- apply synBody+      pure (((synName, synKind'), synBody'), unknowns synKind')+    datResultsWithUnks <- for (zip datDict datResults) $ \((datName, datKind), ctors) -> do+      datKind' <- apply datKind+      ctors' <- traverse (bitraverse (traverseDataCtorFields (traverse (traverse apply))) apply) ctors+      pure (((datName, datKind'), ctors'), unknowns datKind')+    clsResultsWithUnks <- for (zip clsDict clsResults) $ \((clsName, clsKind), (args, supers, decls)) -> do+      clsKind' <- apply clsKind+      args' <- traverse (traverse apply) args+      supers' <- traverse applyConstraint supers+      decls' <- traverse applyClassMemberDeclaration decls+      pure (((clsName, clsKind'), (args', supers', decls')), unknowns clsKind')+    let synUnks = fmap (\(((synName, _), _), unks) -> (synName, unks)) synResultsWithUnks+        datUnks = fmap (\(((datName, _), _), unks) -> (datName, unks)) datResultsWithUnks+        clsUnks = fmap (\(((clsName, _), _), unks) -> (clsName, unks)) clsResultsWithUnks+        tysUnks = synUnks <> datUnks <> clsUnks+    allUnks <- unknownsWithKinds . IS.toList $ foldMap snd tysUnks+    let mkTySub (name, unks) = do+          let tyCtorName = mkQualified name moduleName+              tyUnks = filter (flip IS.member unks . fst) allUnks+              tyCtor = foldl (\ty -> srcKindApp ty . TUnknown nullSourceAnn . fst) (srcTypeConstructor tyCtorName) tyUnks+          (tyCtorName, (tyCtor, tyUnks))+        tySubs = fmap mkTySub tysUnks+        replaceTypeCtors = everywhereOnTypes $ \case+          TypeConstructor _ name+            | Just (tyCtor, _) <- lookup name tySubs -> tyCtor+          other -> other+        clsResultsWithKinds = flip fmap clsResultsWithUnks $ \(((clsName, clsKind), (args, supers, decls)), _) -> do+          let tyUnks = snd . fromJust $ lookup (mkQualified clsName moduleName) tySubs+              (usedTypeVariablesInDecls, _, _, _, _) = accumTypes usedTypeVariables+              usedVars = usedTypeVariables clsKind+                      <> foldMap (usedTypeVariables . snd) args+                      <> foldMap (foldMap usedTypeVariables . (\c -> constraintKindArgs c <> constraintArgs c)) supers+                      <> foldMap usedTypeVariablesInDecls decls+              unkBinders = unknownVarNames usedVars tyUnks+              args' = fmap (replaceUnknownsWithVars unkBinders . replaceTypeCtors) <$> args+              supers' = mapConstraintArgsAll (fmap (replaceUnknownsWithVars unkBinders . replaceTypeCtors)) <$> supers+              decls' = mapTypeDeclaration (replaceUnknownsWithVars unkBinders . replaceTypeCtors) <$> decls+          (args', supers', decls', generalizeUnknownsWithVars unkBinders clsKind)+    datResultsWithKinds <- for datResultsWithUnks $ \(((datName, datKind), ctors), _) -> do+      let tyUnks = snd . fromJust $ lookup (mkQualified datName moduleName) tySubs+          replaceDataCtorField ty = replaceUnknownsWithVars (unknownVarNames (usedTypeVariables ty) tyUnks) $ replaceTypeCtors ty+          ctors' = fmap (mapDataCtorFields (fmap (fmap replaceDataCtorField)) *** generalizeUnknowns tyUnks . replaceTypeCtors) ctors+      traverse_ (traverse_ checkTypeQuantification) ctors'+      pure (ctors', generalizeUnknowns tyUnks datKind)+    synResultsWithKinds <- for synResultsWithUnks $ \(((synName, synKind), synBody), _) -> do+      let tyUnks = snd . fromJust $ lookup (mkQualified synName moduleName) tySubs+          unkBinders = unknownVarNames (usedTypeVariables synKind <> usedTypeVariables synBody) tyUnks+          genBody = replaceUnknownsWithVars unkBinders $ replaceTypeCtors synBody+          genSig = generalizeUnknownsWithVars unkBinders synKind+      checkEscapedSkolems genBody+      checkTypeQuantification genBody+      checkVisibleTypeQuantification genSig+      pure (genBody, genSig)+    pure (synResultsWithKinds, datResultsWithKinds, clsResultsWithKinds)
src/Language/PureScript/TypeChecker/Monad.hs view
@@ -13,23 +13,44 @@ import Control.Monad.State import Control.Monad.Writer.Class (MonadWriter(..), censor) +import Data.List (intercalate) import Data.Maybe import qualified Data.Map as M-import Data.Text (Text)+import qualified Data.Set as S+import Data.Text (Text, isPrefixOf, unpack) import qualified Data.List.NonEmpty as NEL  import Language.PureScript.Crash (internalError) import Language.PureScript.Environment import Language.PureScript.Errors-import Language.PureScript.Kinds import Language.PureScript.Names+import Language.PureScript.Pretty.Types+import Language.PureScript.Pretty.Values import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types+import Text.PrettyPrint.Boxes (render) --- | A substitution of unification variables for types or kinds+newtype UnkLevel = UnkLevel (NEL.NonEmpty Unknown)+  deriving (Eq, Show)++-- This instance differs from the NEL instance in that longer but otherwise+-- equal paths are LT rather than GT. An extended path puts it *before* its root.+instance Ord UnkLevel where+  compare (UnkLevel a) (UnkLevel b) =+    go (NEL.toList a) (NEL.toList b)+    where+    go [] [] = EQ+    go _  [] = LT+    go [] _  = GT+    go (x:xs) (y:ys) =+      compare x y <> go xs ys++-- | A substitution of unification variables for types. data Substitution = Substitution-  { substType :: M.Map Int SourceType -- ^ Type substitution-  , substKind :: M.Map Int SourceKind -- ^ Kind substitution+  { substType :: M.Map Int SourceType+  -- ^ Type substitution+  , substUnsolved :: M.Map Int (UnkLevel, SourceType)+  -- ^ Unsolved unification variables with their level (scope ordering) and kind   }  -- | An empty substitution@@ -42,14 +63,24 @@   -- ^ The current @Environment@   , checkNextType :: Int   -- ^ The next type unification variable-  , checkNextKind :: Int-  -- ^ The next kind unification variable   , checkNextSkolem :: Int   -- ^ The next skolem variable   , checkNextSkolemScope :: Int   -- ^ The next skolem scope constant   , checkCurrentModule :: Maybe ModuleName   -- ^ The current module+  , checkCurrentModuleImports ::+      [ ( SourceAnn+        , ModuleName+        , ImportDeclarationType+        , Maybe ModuleName+        , M.Map (ProperName 'TypeName) ([ProperName 'ConstructorName], ExportSource)+        )+      ]+  -- ^ The current module imports and their exported types.+  -- Newtype constructors have to be in scope for some Coercible constraints to+  -- be solvable, so we need to know which constructors are imported and whether+  -- they are actually defined in or re-exported from the imported modules.   , checkSubstitution :: Substitution   -- ^ The current substitution   , checkHints :: [ErrorMessageHint]@@ -57,11 +88,14 @@   -- This goes into state, rather than using 'rethrow',   -- since this way, we can provide good error messages   -- during instance resolution.+  , checkConstructorImportsForCoercible :: S.Set (ModuleName, Qualified (ProperName 'ConstructorName))+  -- ^ Newtype constructors imports required to solve Coercible constraints.+  -- We have to keep track of them so that we don't emit unused import warnings.   }  -- | Create an empty @CheckState@ emptyCheckState :: Environment -> CheckState-emptyCheckState env = CheckState env 0 0 0 0 Nothing emptySubstitution []+emptyCheckState env = CheckState env 0 0 0 Nothing [] emptySubstitution [] mempty  -- | Unification variables type Unknown = Int@@ -82,7 +116,7 @@ -- | Temporarily bind a collection of names to types bindTypes   :: MonadState CheckState m-  => M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)+  => M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)   -> m a   -> m a bindTypes newNames action = do@@ -96,7 +130,7 @@ withScopedTypeVars   :: (MonadState CheckState m, MonadWriter MultipleErrors m)   => ModuleName-  -> [(Text, SourceKind)]+  -> [(Text, SourceType)]   -> m a   -> m a withScopedTypeVars mn ks ma = do@@ -193,7 +227,7 @@ bindLocalTypeVariables   :: (MonadState CheckState m)   => ModuleName-  -> [(ProperName 'TypeName, SourceKind)]+  -> [(ProperName 'TypeName, SourceType)]   -> m a   -> m a bindLocalTypeVariables moduleName bindings =@@ -253,7 +287,7 @@   :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m)   => ModuleName   -> Qualified (ProperName 'TypeName)-  -> m SourceKind+  -> m SourceType lookupTypeVariable currentModule (Qualified moduleName name) = do   env <- getEnv   case M.lookup (Qualified (Just $ fromMaybe currentModule moduleName) name) (types env) of@@ -332,3 +366,106 @@ unsafeCheckCurrentModule = checkCurrentModule <$> get >>= \case   Nothing -> internalError "No module name set in scope"   Just name -> pure name++debugEnv :: Environment -> [String]+debugEnv env = join+  [ debugTypes env+  , debugTypeSynonyms env+  , debugTypeClasses env+  , debugTypeClassDictionaries env+  , debugDataConstructors env+  , debugNames env+  ]++debugType :: Type a -> String+debugType = init . prettyPrintType 100++debugConstraint :: Constraint a -> String+debugConstraint (Constraint ann clsName kinds args _) =+  debugType $ foldl (TypeApp ann) (foldl (KindApp ann) (TypeConstructor ann (fmap coerceProperName clsName)) kinds) args++debugTypes :: Environment -> [String]+debugTypes = go <=< M.toList . types+  where+  go (qual, (srcTy, which)) = do+    let+      ppTy = prettyPrintType 100 srcTy+      name = showQualified runProperName qual+      decl = case which of+        DataType _ _ _    -> "data"+        TypeSynonym       -> "type"+        ExternData _      -> "extern"+        LocalTypeVariable -> "local"+        ScopedTypeVar     -> "scoped"+    guard (not (isPrefixOf "Prim" name))+    pure $ decl <> " " <> unpack name <> " :: " <> init ppTy++debugNames :: Environment -> [String]+debugNames = fmap go . M.toList . names+  where+  go (qual, (srcTy, _, _)) = do+    let+      ppTy = prettyPrintType 100 srcTy+      name = showQualified runIdent qual+    unpack name <> " :: " <> init ppTy++debugDataConstructors :: Environment -> [String]+debugDataConstructors = fmap go . M.toList . dataConstructors+  where+  go (qual, (_, _, ty, _)) = do+    let+      ppTy = prettyPrintType 100 ty+      name = showQualified runProperName qual+    unpack name <> " :: " <> init ppTy++debugTypeSynonyms :: Environment -> [String]+debugTypeSynonyms = fmap go . M.toList . typeSynonyms+  where+  go (qual, (binders, subTy)) = do+    let+      vars = intercalate " " $ flip fmap binders $ \case+               (v, Just k) -> "(" <> unpack v <> " :: " <> init (prettyPrintType 100 k) <> ")"+               (v, Nothing) -> unpack v+      ppTy = prettyPrintType 100 subTy+      name = showQualified runProperName qual+    "type " <> unpack name <> " " <> vars <> " = " <> init ppTy++debugTypeClassDictionaries :: Environment -> [String]+debugTypeClassDictionaries = go . typeClassDictionaries+  where+  go tcds = do+    (mbModuleName, classes) <- M.toList tcds+    (className, instances) <- M.toList classes+    (ident, dicts) <- M.toList instances+    let+      moduleName = maybe "" (\m -> "[" <> runModuleName m <> "] ") mbModuleName+      className' = showQualified runProperName className+      ident' = showQualified runIdent ident+      kds = intercalate " " $ fmap ((\a -> "@(" <> a <> ")") . debugType) $ tcdInstanceKinds $ NEL.head dicts+      tys = intercalate " " $ fmap ((\a -> "(" <> a <> ")") . debugType) $ tcdInstanceTypes $ NEL.head dicts+    pure $ "dict " <> unpack moduleName <> unpack className' <> " " <> unpack ident' <> " (" <> show (length dicts) <> ")" <> " " <> kds <> " " <> tys++debugTypeClasses :: Environment -> [String]+debugTypeClasses = fmap go . M.toList . typeClasses+  where+  go (className, tc) = do+    let+      className' = showQualified runProperName className+      args = intercalate " " $ fmap (\(a, b) -> "(" <> debugType (maybe (srcTypeVar a) (srcKindedType (srcTypeVar a)) b) <> ")") $ typeClassArguments tc+    "class " <> unpack className' <> " " <> args++debugValue :: Expr -> String+debugValue = init . render . prettyPrintValue 100++debugSubstitution :: Substitution -> [String]+debugSubstitution (Substitution solved unsolved) =+  fmap go1 (M.toList solved) <> fmap go2 (M.toList unsolved')+  where+  unsolved' =+    M.filterWithKey (\k _ -> M.notMember k solved) unsolved++  go1 (u, ty) =+    "?" <> show u <> " = " <> debugType ty++  go2 (u, (_, k)) =+    "?" <> show u <> " :: " <> debugType k
+ src/Language/PureScript/TypeChecker/Roles.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Role inference+--+module Language.PureScript.TypeChecker.Roles+  ( lookupRoles+  , checkRoles+  , checkDataBindingGroupRoles+  ) where++import Prelude.Compat++import Control.Monad.Error.Class (MonadError(..))+import Control.Monad.State (MonadState(..), runState, state)+import Data.Coerce (coerce)+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import qualified Data.Set as S+import Data.Semigroup (Any(..))+import Data.Text (Text)++import Language.PureScript.Environment+import Language.PureScript.Errors+import Language.PureScript.Names+import Language.PureScript.Roles+import Language.PureScript.Types++-- |+-- A map of a type's formal parameter names to their roles. This type's+-- @Semigroup@ and @Monoid@ instances preserve the least-permissive role+-- ascribed to any given variable, as defined by the @Role@ type's @Ord@+-- instance. That is, a variable that has been marked as @Nominal@ can not+-- later be marked @Representational@, and so on.+newtype RoleMap = RoleMap { getRoleMap :: M.Map Text Role }++instance Semigroup RoleMap where+  (<>) =+    coerce @(M.Map Text Role -> _ -> _) @(RoleMap -> _ -> _) (M.unionWith min)++instance Monoid RoleMap where+  mempty =+    RoleMap M.empty++type RoleEnv = M.Map (Qualified (ProperName 'TypeName)) [Role]++typeKindRoles :: TypeKind -> Maybe [Role]+typeKindRoles = \case+  DataType _ args _ ->+    Just $ map (\(_, _, role) -> role) args+  ExternData roles ->+    Just roles+  _ ->+    Nothing++getRoleEnv :: Environment -> RoleEnv+getRoleEnv env =+  M.mapMaybe (typeKindRoles . snd) (types env)++updateRoleEnv+  :: Qualified (ProperName 'TypeName)+  -> [Role]+  -> RoleEnv+  -> (Any, RoleEnv)+updateRoleEnv qualTyName roles' roleEnv =+  let roles = fromMaybe (repeat Phantom) $ M.lookup qualTyName roleEnv+      mostRestrictiveRoles = zipWith min roles roles'+      didRolesChange = any (uncurry (<)) $ zip mostRestrictiveRoles roles+  in (Any didRolesChange, M.insert qualTyName mostRestrictiveRoles roleEnv)++-- |+-- Lookup the roles for a type in the environment. If the type does not have+-- roles (e.g. is a type synonym or a type variable), then this function+-- returns an empty list.+--+lookupRoles+  :: Environment+  -> Qualified (ProperName 'TypeName)+  -> [Role]+lookupRoles env tyName =+  fromMaybe [] $ M.lookup tyName (types env) >>= typeKindRoles . snd++-- | This function does the following:+--+-- * Infers roles for the given data type declaration+--+-- * Compares the inferred roles to the explicitly declared roles (if any) and+--   ensures that the explicitly declared roles are not more permissive than+--   the inferred ones+--+checkRoles+  :: forall m+   . (MonadError MultipleErrors m)+  => Environment+  -> ModuleName+  -> ProperName 'TypeName+    -- ^ The name of the data type whose roles we are checking+  -> [(Text, Maybe SourceType)]+    -- ^ type parameters for the data type whose roles we are checking+  -> [DataConstructorDeclaration]+    -- ^ constructors of the data type whose roles we are checking+  -> m [Role]+checkRoles env moduleName tyName tyArgs ctors =+  checkDataBindingGroupRoles env moduleName [(tyName, tyArgs, ctors)] tyName tyArgs++type DataDeclaration =+  ( ProperName 'TypeName+  , [(Text, Maybe SourceType)]+  , [DataConstructorDeclaration]+  )++checkDataBindingGroupRoles+  :: forall m+   . (MonadError MultipleErrors m)+  => Environment+  -> ModuleName+  -> [DataDeclaration]+  -> ProperName 'TypeName+  -> [(Text, Maybe SourceType)]+  -> m [Role]+checkDataBindingGroupRoles env moduleName group =+  let initialRoleEnv = M.union (roleDeclarations env) (getRoleEnv env)+      inferredRoleEnv = inferDataBindingGroupRoles moduleName group initialRoleEnv+  in \tyName tyArgs -> do+    let qualTyName = Qualified (Just moduleName) tyName+        inferredRoles = M.lookup qualTyName inferredRoleEnv+    rethrow (addHint (ErrorInRoleDeclaration tyName)) $ do+      case M.lookup qualTyName (roleDeclarations env) of+        Just declaredRoles -> do+          let+            k (var, _) inf dec =+              if inf < dec+                then throwError . errorMessage $ RoleMismatch var inf dec+                else pure dec+          sequence $ zipWith3 k tyArgs (fromMaybe (repeat Phantom) inferredRoles) declaredRoles+        Nothing ->+          pure $ fromMaybe (Phantom <$ tyArgs) inferredRoles++inferDataBindingGroupRoles+  :: ModuleName+  -> [DataDeclaration]+  -> RoleEnv+  -> RoleEnv+inferDataBindingGroupRoles moduleName group roleEnv =+  let (Any didRolesChange, roleEnv') = flip runState roleEnv $+        mconcat <$> traverse (state . inferDataDeclarationRoles moduleName) group+  in if didRolesChange+     then inferDataBindingGroupRoles moduleName group roleEnv'+     else roleEnv'++-- |+-- Infers roles for the given data type declaration, along with a flag to tell+-- if more restrictive roles were added to the environment.+--+inferDataDeclarationRoles+  :: ModuleName+  -> DataDeclaration+  -> RoleEnv+  -> (Any, RoleEnv)+inferDataDeclarationRoles moduleName (tyName, tyArgs, ctors) roleEnv =+  let qualTyName = Qualified (Just moduleName) tyName+      ctorRoles = getRoleMap . foldMap (walk mempty . snd) $ ctors >>= dataCtorFields+      inferredRoles = map (\(arg, _) -> fromMaybe Phantom (M.lookup arg ctorRoles)) tyArgs+  in updateRoleEnv qualTyName inferredRoles roleEnv+  where+  -- This function is named @walk@ to match the specification given in the+  -- "Role inference" section of the paper "Safe Zero-cost Coercions for+  -- Haskell".+  walk :: S.Set Text -> SourceType -> RoleMap+  walk btvs (TypeVar _ v)+    -- A type variable standing alone (e.g. @a@ in @data D a b = D a@) is+    -- representational, _unless_ it has been bound by a quantifier, in which+    -- case it is not actually a parameter to the type (e.g. @z@ in+    -- @data T z = T (forall z. z -> z)@).+    | S.member v btvs =+        mempty+    | otherwise =+        RoleMap $ M.singleton v Representational+  walk btvs (ForAll _ tv _ t _) =+    -- We can walk under universal quantifiers as long as we make note of the+    -- variables that they bind. For instance, given a definition+    -- @data T z = T (forall z. z -> z)@, we will make note that @z@ is bound+    -- by a quantifier so that we do not mark @T@'s parameter as+    -- representational later on. Similarly, given a definition like+    -- @data D a = D (forall r. r -> a)@, we'll mark @r@ as bound so that it+    -- doesn't appear as a spurious parameter to @D@ when we complete+    -- inference.+    walk (S.insert tv btvs) t+  walk btvs (ConstrainedType _ Constraint{..} t) =+    -- For constrained types, mark all free variables in the constraint+    -- arguments as nominal and recurse on the type beneath the constraint.+    walk btvs t <> foldMap (freeNominals btvs) constraintArgs+  walk btvs (RCons _ _ thead ttail) = do+    -- For row types, we just walk along them and collect the results.+    walk btvs thead <> walk btvs ttail+  walk btvs (KindedType _ t _k) =+    -- For kind-annotated types, discard the annotation and recurse on the+    -- type beneath.+    walk btvs t+  walk btvs t+    | (t1, _, t2s) <- unapplyTypes t+    , not $ null t2s =+        case t1 of+          -- If the type is an application of a type constructor to some+          -- arguments, recursively infer the roles of the type constructor's+          -- arguments. For each (role, argument) pair:+          --+          -- * If the role is nominal, mark all free variables in the+          --   argument as nominal also, since they cannot be coerced if the+          --   argument's nominality is to be preserved.+          -- * If the role is representational, recurse on the argument, since+          --   its use of our parameters is important.+          -- * If the role is phantom, terminate, since the argument's use of+          --   our parameters is unimportant.+          TypeConstructor _ t1Name ->+            let+              t1Roles = fromMaybe (repeat Phantom) $ M.lookup t1Name roleEnv+              k role ti = case role of+                Nominal ->+                  freeNominals btvs ti+                Representational ->+                  go ti+                Phantom ->+                  mempty+            in mconcat (zipWith k t1Roles t2s)+          -- If the type is an application of any other type-level term, walk+          -- that term to collect its roles and mark all free variables in+          -- its argument as nominal.+          _ -> do+            go t1 <> foldMap (freeNominals btvs) t2s+    | otherwise =+        mempty+    where+      go = walk btvs++-- Given a type, computes the list of free variables in that type+-- (taking into account those bound in @walk@) and returns a @RoleMap@+-- ascribing a nominal role to each of those variables.+freeNominals :: S.Set Text -> SourceType -> RoleMap+freeNominals btvs x =+  let ftvs = filter (flip S.notMember btvs) (freeTypeVariables x)+  in  RoleMap (M.fromList $ map (, Nominal) ftvs)
src/Language/PureScript/TypeChecker/Skolems.hs view
@@ -45,14 +45,14 @@   return $ SkolemScope s  -- | Skolemize a type variable by replacing its instances with fresh skolem constants-skolemize :: a -> Text -> Int -> SkolemScope -> Type a -> Type a-skolemize ann ident sko scope = replaceTypeVars ident (Skolem ann ident sko scope)+skolemize :: a -> Text -> Maybe (Type a) -> Int -> SkolemScope -> Type a -> Type a+skolemize ann ident mbK sko scope = replaceTypeVars ident (Skolem ann ident mbK sko scope)  -- | This function skolemizes type variables appearing in any type signatures or -- 'DeferredDictionary' placeholders. These type variables are the only places -- where scoped type variables can appear in expressions.-skolemizeTypesInValue :: SourceAnn -> Text -> Int -> SkolemScope -> Expr -> Expr-skolemizeTypesInValue ann ident sko scope =+skolemizeTypesInValue :: SourceAnn -> Text -> Maybe SourceType -> Int -> SkolemScope -> Expr -> Expr+skolemizeTypesInValue ann ident mbK sko scope =     runIdentity . onExpr'   where     onExpr' :: Expr -> Identity Expr@@ -60,14 +60,14 @@      onExpr :: [Text] -> Expr -> Identity ([Text], Expr)     onExpr sco (DeferredDictionary c ts)-      | ident `notElem` sco = return (sco, DeferredDictionary c (map (skolemize ann ident sko scope) ts))+      | ident `notElem` sco = return (sco, DeferredDictionary c (map (skolemize ann ident mbK sko scope) ts))     onExpr sco (TypedValue check val ty)-      | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedValue check val (skolemize ann ident sko scope ty))+      | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedValue check val (skolemize ann ident mbK sko scope ty))     onExpr sco other = return (sco, other)      onBinder :: [Text] -> Binder -> Identity ([Text], Binder)     onBinder sco (TypedBinder ty b)-      | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedBinder (skolemize ann ident sko scope ty) b)+      | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedBinder (skolemize ann ident mbK sko scope ty) b)     onBinder sco other = return (sco, other)      peelTypeVars :: SourceType -> [Text]@@ -123,7 +123,7 @@         -- Collect any skolem variables appearing in a type         collectSkolems :: SourceType -> [(SourceAnn, Text, SkolemScope)]         collectSkolems = everythingOnTypes (++) collect where-          collect (Skolem ss name _ scope) = [(ss, name, scope)]+          collect (Skolem ss name _ _ scope) = [(ss, name, scope)]           collect _ = []     go scos _ = (scos, []) skolemEscapeCheck _ = internalError "skolemEscapeCheck: untyped value"
src/Language/PureScript/TypeChecker/Subsumption.hs view
@@ -75,14 +75,15 @@   -> SourceType   -> SourceType   -> m (Coercion mode)-subsumes' mode (ForAll _ ident _ ty1 _) ty2 = do-  replaced <- replaceVarWithUnknown ident ty1+subsumes' mode (ForAll _ ident mbK ty1 _) ty2 = do+  u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK+  let replaced = replaceTypeVars ident u ty1   subsumes' mode replaced ty2-subsumes' mode ty1 (ForAll _ ident _ ty2 sco) =+subsumes' mode ty1 (ForAll _ ident mbK ty2 sco) =   case sco of     Just sco' -> do       sko <- newSkolemConstant-      let sk = skolemize NullSourceAnn ident sko sco' ty2+      let sk = skolemize NullSourceAnn ident mbK sko sco' ty2       subsumes' mode ty1 sk     Nothing -> internalError "subsumes: unspecified skolem scope" subsumes' mode (TypeApp _ (TypeApp _ f1 arg1) ret1) (TypeApp _ (TypeApp _ f2 arg2) ret2) | eqType f1 tyFunction && eqType f2 tyFunction = do@@ -108,9 +109,9 @@     -- every property in ts2 must appear in ts1. If not, then the candidate expression is missing a required property.     -- Conversely, when r2 is empty, every property in ts1 must appear in ts2, or else the expression has     -- an additional property which is not allowed.-    when (eqType r1' $ REmpty ())+    when (isREmpty r1')       (for_ (firstMissingProp ts2' ts1') (throwError . errorMessage . PropertyIsMissing . rowListLabel))-    when (eqType r2' $ REmpty ())+    when (isREmpty r2')       (for_ (firstMissingProp ts1' ts2') (throwError . errorMessage . AdditionalProperty . rowListLabel))     -- Check subsumption for common labels     sequence_ common
src/Language/PureScript/TypeChecker/Synonyms.hs view
@@ -5,6 +5,7 @@ -- module Language.PureScript.TypeChecker.Synonyms   ( SynonymMap+  , KindMap   , replaceAllTypeSynonyms   , replaceAllTypeSynonymsM   ) where@@ -18,45 +19,54 @@ import           Data.Text (Text) import           Language.PureScript.Environment import           Language.PureScript.Errors-import           Language.PureScript.Kinds import           Language.PureScript.Names import           Language.PureScript.TypeChecker.Monad import           Language.PureScript.Types  -- | Type synonym information (arguments with kinds, aliased type), indexed by name-type SynonymMap = M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceKind)], SourceType)+type SynonymMap = M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceType)], SourceType) +type KindMap = M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)+ replaceAllTypeSynonyms'   :: SynonymMap+  -> KindMap   -> SourceType   -> Either MultipleErrors SourceType-replaceAllTypeSynonyms' syns = everywhereOnTypesTopDownM try+replaceAllTypeSynonyms' syns kinds = everywhereOnTypesTopDownM try   where   try :: SourceType -> Either MultipleErrors SourceType-  try t = fromMaybe t <$> go 0 [] t+  try t = fromMaybe t <$> go (fst $ getAnnForType t) 0 [] [] t -  go :: Int -> [SourceType] -> SourceType -> Either MultipleErrors (Maybe SourceType)-  go c args (TypeConstructor _ ctor)+  go :: SourceSpan -> Int -> [SourceType] -> [SourceType] -> SourceType -> Either MultipleErrors (Maybe SourceType)+  go ss c kargs args (TypeConstructor _ ctor)     | Just (synArgs, body) <- M.lookup ctor syns     , c == length synArgs-    = let repl = replaceAllTypeVars (zip (map fst synArgs) args) body+    , kindArgs <- lookupKindArgs ctor+    , length kargs == length kindArgs+    = let repl = replaceAllTypeVars (zip (map fst synArgs) args <> zip kindArgs kargs) body       in Just <$> try repl     | Just (synArgs, _) <- M.lookup ctor syns     , length synArgs > c-    = throwError . errorMessage $ PartiallyAppliedSynonym ctor-  go c args (TypeApp _ f arg) = go (c + 1) (arg : args) f-  go _ _ _ = return Nothing+    = throwError . errorMessage' ss $ PartiallyAppliedSynonym ctor+  go ss c kargs args (TypeApp _ f arg) = go ss (c + 1) kargs (arg : args) f+  go ss c kargs args (KindApp _ f arg) = go ss c (arg : kargs) args f+  go _ _ _ _ _ = return Nothing +  lookupKindArgs :: Qualified (ProperName 'TypeName) -> [Text]+  lookupKindArgs ctor = fromMaybe [] $ fmap (fmap (fst . snd) . fst) . completeBinderList . fst =<< M.lookup ctor kinds+ -- | Replace fully applied type synonyms replaceAllTypeSynonyms :: (e ~ MultipleErrors, MonadState CheckState m, MonadError e m) => SourceType -> m SourceType replaceAllTypeSynonyms d = do   env <- getEnv-  either throwError return $ replaceAllTypeSynonyms' (typeSynonyms env) d+  either throwError return $ replaceAllTypeSynonyms' (typeSynonyms env) (types env) d  -- | Replace fully applied type synonyms by explicitly providing a 'SynonymMap'. replaceAllTypeSynonymsM   :: MonadError MultipleErrors m   => SynonymMap+  -> KindMap   -> SourceType   -> m SourceType-replaceAllTypeSynonymsM syns = either throwError pure . replaceAllTypeSynonyms' syns+replaceAllTypeSynonymsM syns kinds = either throwError pure . replaceAllTypeSynonyms' syns kinds
src/Language/PureScript/TypeChecker/TypeSearch.hs view
@@ -93,8 +93,8 @@    userT' <- initializeSkolems userT -  rowType <- freshType-  resultType <- freshType+  rowType <- freshTypeWithKind (P.kindRow P.kindType)+  resultType <- freshTypeWithKind P.kindType   let recordFunction = srcTypeApp (srcTypeApp tyFunction (srcTypeApp tyRecord rowType)) resultType   _ <- subsumes recordFunction userT'   subst <- gets TC.checkSubstitution
src/Language/PureScript/TypeChecker/Types.hs view
@@ -6,6 +6,7 @@ module Language.PureScript.TypeChecker.Types   ( BindingGroupType(..)   , typesOf+  , checkTypeKind   ) where  {-@@ -39,16 +40,17 @@ import Data.Functor (($>)) import Data.List (transpose, (\\), partition, delete) import Data.Maybe (fromMaybe)+import Data.Text (Text) import Data.Traversable (for) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as M import qualified Data.Set as S+import qualified Data.IntSet as IS  import Language.PureScript.AST import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors-import Language.PureScript.Kinds import Language.PureScript.Names import Language.PureScript.Traversals import Language.PureScript.TypeChecker.Entailment@@ -96,8 +98,10 @@       -- Generalize and constrain the type       currentSubst <- gets checkSubstitution       let ty' = substituteType currentSubst ty-          unsolvedTypeVars = ordNub $ unknownsInType ty'-          generalized = generalize unsolved ty'+          ty'' = constrain unsolved ty'+      unsolvedTypeVarsWithKinds <- unknownsWithKinds . IS.toList . unknowns $ constrain unsolved ty''+      let unsolvedTypeVars = IS.toList $ unknowns ty'+          generalized = varIfUnknown unsolvedTypeVarsWithKinds ty''        when shouldGeneralize $ do         -- Show the inferred type in a warning@@ -141,8 +145,8 @@               lookupUnknowns = atMay conArgUnknowns               unknownsDetermined :: Maybe (S.Set Int) -> Bool               unknownsDetermined Nothing = False-              unknownsDetermined (Just unknowns) =-                unknowns `S.isSubsetOf` determined+              unknownsDetermined (Just unks) =+                unks `S.isSubsetOf` determined             -- If all of the determining arguments of a particular fundep are             -- already determined, add the determined arguments from the fundep             tcDep <- tcDeps@@ -150,7 +154,7 @@             map (fromMaybe S.empty . lookupUnknowns) (fdDetermined tcDep)         -- These unknowns can be determined from the body of the inferred         -- type (i.e. excluding the unknowns mentioned in the constraints)-        let determinedFromType = S.fromList . map snd $ unsolvedTypeVars+        let determinedFromType = S.fromList unsolvedTypeVars         -- These are all the unknowns mentioned in the constraints         let constraintTypeVars = fold (conData >>= snd)         let solved = solveFrom determinedFromType@@ -201,9 +205,6 @@         in ErrorMessage hints (HoleInferredType x ty y (Just searchResult))       other -> other -    -- | Generalize type vars using forall and add inferred constraints-    generalize unsolved = varIfUnknown . constrain unsolved-     -- | Add any unsolved constraints     constrain cs ty = foldr srcConstrainedType ty (map (\(_, _, x) -> x) cs) @@ -222,7 +223,7 @@ data SplitBindingGroup = SplitBindingGroup   { _splitBindingGroupUntyped :: [((SourceAnn, Ident), (Expr, SourceType))]   -- ^ The untyped expressions-  , _splitBindingGroupTyped :: [((SourceAnn, Ident), (Expr, SourceType, Bool))]+  , _splitBindingGroupTyped :: [((SourceAnn, Ident), (Expr, [(Text, SourceType)], SourceType, Bool))]   -- ^ The typed expressions, along with their type annotations   , _splitBindingGroupNames :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)   -- ^ A map containing all expressions and their assigned types (which might be@@ -236,7 +237,7 @@ -- This function also generates fresh unification variables for the types of -- declarations without type annotations, returned in the 'UntypedData' structure. typeDictionaryForBindingGroup-  :: (MonadState CheckState m, MonadWriter MultipleErrors m)+  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => Maybe ModuleName   -> [((SourceAnn, Ident), Expr)]   -> m SplitBindingGroup@@ -246,11 +247,13 @@     -- fully expanded types.     let (untyped, typed) = partitionEithers (map splitTypeAnnotation vals)     (typedDict, typed') <- fmap unzip . for typed $ \(sai, (expr, ty, checkType)) -> do-      ty' <- replaceTypeWildcards ty-      return ((sai, ty'), (sai, (expr, ty', checkType)))+      ((args, elabTy), kind) <- kindOfWithScopedVars ty+      checkTypeKind ty kind+      elabTy' <- replaceTypeWildcards elabTy+      return ((sai, elabTy'), (sai, (expr, args, elabTy', checkType)))     -- Create fresh unification variables for the types of untyped declarations     (untypedDict, untyped') <- fmap unzip . for untyped $ \(sai, expr) -> do-      ty <- freshType+      ty <- freshTypeWithKind kindType       return ((sai, ty), (sai, (expr, ty)))     -- Create the dictionary of all name/type pairs, which will be added to the     -- environment during type checking@@ -273,15 +276,12 @@ checkTypedBindingGroupElement   :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => ModuleName-  -> ((SourceAnn, Ident), (Expr, SourceType, Bool))+  -> ((SourceAnn, Ident), (Expr, [(Text, SourceType)], SourceType, Bool))   -- ^ The identifier we are trying to define, along with the expression and its type annotation   -> M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)   -- ^ Names brought into scope in this binding group   -> m ((SourceAnn, Ident), (Expr, SourceType))-checkTypedBindingGroupElement mn (ident, (val, ty, checkType)) dict = do-  -- Kind check-  (kind, args) <- kindOfWithScopedVars ty-  checkTypeKind ty kind+checkTypedBindingGroupElement mn (ident, (val, args, ty, checkType)) dict = do   -- We replace type synonyms _after_ kind-checking, since we don't want type   -- synonym expansion to bring type variables into scope. See #2542.   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty@@ -307,14 +307,6 @@   unifyTypes ty ty'   return (ident, (TypedValue True val' ty', ty')) --- | Check the kind of a type, failing if it is not of kind *.-checkTypeKind-  :: MonadError MultipleErrors m-  => SourceType-  -> SourceKind-  -> m ()-checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ isKindType kind- -- | Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns -- or TypeClassDictionary values. --@@ -325,13 +317,13 @@   => Expr   -> SourceType   -> m (Expr, SourceType)-instantiatePolyTypeWithUnknowns val (ForAll _ ident _ ty _) = do-  ty' <- replaceVarWithUnknown ident ty-  instantiatePolyTypeWithUnknowns val ty'+instantiatePolyTypeWithUnknowns val (ForAll _ ident mbK ty _) = do+  u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK+  instantiatePolyTypeWithUnknowns val $ replaceTypeVars ident u ty instantiatePolyTypeWithUnknowns val (ConstrainedType _ con ty) = do-   dicts <- getTypeClassDictionaries-   hints <- getHints-   instantiatePolyTypeWithUnknowns (App val (TypeClassDictionary con dicts hints)) ty+  dicts <- getTypeClassDictionaries+  hints <- getHints+  instantiatePolyTypeWithUnknowns (App val (TypeClassDictionary con dicts hints)) ty instantiatePolyTypeWithUnknowns val ty = return (val, ty)  -- | Infer a type for a value, rethrowing any error to provide a more useful error message@@ -354,7 +346,7 @@ infer' v@(Literal _ (BooleanLiteral _)) = return $ TypedValue' True v tyBoolean infer' (Literal ss (ArrayLiteral vals)) = do   ts <- traverse infer vals-  els <- freshType+  els <- freshTypeWithKind kindType   ts' <- forM ts $ \(TypedValue' ch val t) -> do     (val', t') <- instantiatePolyTypeWithUnknowns val t     unifyTypes els t'@@ -381,27 +373,27 @@       toRowListItem (lbl, (_, ty)) = srcRowListItem (Label lbl) ty    fields <- forM ps inferProperty-  let ty = srcTypeApp tyRecord $ rowFromList (map toRowListItem fields, srcREmpty)+  let ty = srcTypeApp tyRecord $ rowFromList (map toRowListItem fields, srcKindApp srcREmpty kindType)   return $ TypedValue' True (Literal ss (ObjectLiteral (map (fmap (uncurry (TypedValue True))) fields))) ty infer' (ObjectUpdate o ps) = do   ensureNoDuplicateProperties ps-  row <- freshType+  row <- freshTypeWithKind (kindRow kindType)   typedVals <- zipWith (\(name, _) t -> (name, t)) ps <$> traverse (infer . snd) ps   let toRowListItem = uncurry srcRowListItem   let newTys = map (\(name, TypedValue' _ _ ty) -> (Label name, ty)) typedVals-  oldTys <- zip (map (Label . fst) ps) <$> replicateM (length ps) freshType+  oldTys <- zip (map (Label . fst) ps) <$> replicateM (length ps) (freshTypeWithKind kindType)   let oldTy = srcTypeApp tyRecord $ rowFromList (toRowListItem <$> oldTys, row)   o' <- TypedValue True <$> (tvToExpr <$> check o oldTy) <*> pure oldTy   let newVals = map (fmap tvToExpr) typedVals   return $ TypedValue' True (ObjectUpdate o' newVals) $ srcTypeApp tyRecord $ rowFromList (toRowListItem <$> newTys, row) infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do-  field <- freshType-  rest <- freshType+  field <- freshTypeWithKind kindType+  rest <- freshTypeWithKind (kindRow kindType)   typed <- tvToExpr <$> check val (srcTypeApp tyRecord (srcRCons (Label prop) field rest))   return $ TypedValue' True (Accessor prop typed) field infer' (Abs binder ret)   | VarBinder ss arg <- binder = do-      ty <- freshType+      ty <- freshTypeWithKind kindType       withBindingGroupVisible $ bindLocalVariables [(arg, ty, Defined)] $ do         body@(TypedValue' _ _ bodyTy) <- infer' ret         (body', bodyTy') <- instantiatePolyTypeWithUnknowns (tvToExpr body) bodyTy@@ -428,7 +420,7 @@                              return $ TypedValue' True v' ty' infer' (Case vals binders) = do   (vals', ts) <- instantiateForBinders vals binders-  ret <- freshType+  ret <- freshTypeWithKind kindType   binders' <- checkBinders ts ret binders   return $ TypedValue' True (Case vals' binders') ret infer' (IfThenElse cond th el) = do@@ -445,18 +437,19 @@ infer' (DeferredDictionary className tys) = do   dicts <- getTypeClassDictionaries   hints <- getHints+  con <- checkConstraint (srcConstraint className [] tys Nothing)   return $ TypedValue' False-             (TypeClassDictionary (srcConstraint className tys Nothing) dicts hints)+             (TypeClassDictionary con dicts hints)              (foldl srcTypeApp (srcTypeConstructor (fmap coerceProperName className)) tys) infer' (TypedValue checkType val ty) = do   moduleName <- unsafeCheckCurrentModule-  (kind, args) <- kindOfWithScopedVars ty+  ((args, elabTy), kind) <- kindOfWithScopedVars ty   checkTypeKind ty kind-  ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty+  ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ elabTy   tv <- if checkType then withScopedTypeVars moduleName args (check val ty') else return (TypedValue' False val ty)   return $ TypedValue' True (tvToExpr tv) ty' infer' (Hole name) = do-  ty <- freshType+  ty <- freshTypeWithKind kindType   ctx <- getLocalContext   env <- getEnv   tell . errorMessage $ HoleInferredType name ty ctx . Just $ TSBefore env@@ -477,17 +470,17 @@ inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded (TypedValue checkType val ty)] : rest) ret j = do   moduleName <- unsafeCheckCurrentModule   TypedValue' _ val' ty'' <- warnAndRethrowWithPositionTC ss $ do-    (kind, args) <- kindOfWithScopedVars ty+    ((args, elabTy), kind) <- kindOfWithScopedVars ty     checkTypeKind ty kind-    let dict = M.singleton (Qualified Nothing ident) (ty, nameKind, Undefined)-    ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty+    let dict = M.singleton (Qualified Nothing ident) (elabTy, nameKind, Undefined)+    ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ elabTy     if checkType       then withScopedTypeVars moduleName args (bindNames dict (check val ty'))-      else return (TypedValue' checkType val ty)+      else return (TypedValue' checkType val elabTy)   bindNames (M.singleton (Qualified Nothing ident) (ty'', nameKind, Defined))     $ inferLetBinding (seen ++ [ValueDecl sa ident nameKind [] [MkUnguarded (TypedValue checkType val' ty'')]]) rest ret j inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded val] : rest) ret j = do-  valTy <- freshType+  valTy <- freshTypeWithKind kindType   TypedValue' _ val' valTy' <- warnAndRethrowWithPositionTC ss $ do     let dict = M.singleton (Qualified Nothing ident) (valTy, nameKind, Undefined)     bindNames dict $ infer val@@ -539,8 +532,8 @@     go args (TypeApp _ (TypeApp _ fn arg) ret) | eqType fn tyFunction = go (arg : args) ret     go args ret = (args, ret) inferBinder val (LiteralBinder _ (ObjectLiteral props)) = do-  row <- freshType-  rest <- freshType+  row <- freshTypeWithKind (kindRow kindType)+  rest <- freshTypeWithKind (kindRow kindType)   m1 <- inferRowProperties row rest props   unifyTypes val (srcTypeApp tyRecord row)   return m1@@ -548,12 +541,12 @@   inferRowProperties :: SourceType -> SourceType -> [(PSString, Binder)] -> m (M.Map Ident SourceType)   inferRowProperties nrow row [] = unifyTypes nrow row >> return M.empty   inferRowProperties nrow row ((name, binder):binders) = do-    propTy <- freshType+    propTy <- freshTypeWithKind kindType     m1 <- inferBinder propTy binder     m2 <- inferRowProperties nrow (srcRCons (Label name) propTy row) binders     return $ m1 `M.union` m2 inferBinder val (LiteralBinder _ (ArrayLiteral binders)) = do-  el <- freshType+  el <- freshTypeWithKind kindType   m1 <- M.unions <$> traverse (inferBinder el) binders   unifyTypes val (srcTypeApp tyArray el)   return m1@@ -564,9 +557,9 @@ inferBinder val (PositionedBinder pos _ binder) =   warnAndRethrowWithPositionTC pos $ inferBinder val binder inferBinder val (TypedBinder ty binder) = do-  kind <- kindOf ty+  (elabTy, kind) <- kindOf ty   checkTypeKind ty kind-  ty1 <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty+  ty1 <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ elabTy   unifyTypes val ty1   inferBinder ty1 binder inferBinder _ OpBinder{} =@@ -661,16 +654,25 @@   -> SourceType   -> m TypedValue' check' val (ForAll ann ident mbK ty _) = do+  env <- getEnv+  mn <- gets checkCurrentModule   scope <- newSkolemScope   sko <- newSkolemConstant   let ss = case val of              PositionedValue pos c _ -> (pos, c)              _ -> NullSourceAnn-      sk = skolemize ss ident sko scope ty-      skVal = skolemizeTypesInValue ss ident sko scope val+      sk = skolemize ss ident mbK sko scope ty+      -- We should only skolemize types in values when the type variable+      -- was actually brought into scope. Otherwise we can end up skolemizing+      -- an undefined type variable that happens to clash with the variable we+      -- want to skolemize. This can happen due to synonym expansion (see 2542).+      skVal+        | Just _ <- M.lookup (Qualified mn (ProperName ident)) $ types env =+            skolemizeTypesInValue ss ident mbK sko scope val+        | otherwise = val   val' <- tvToExpr <$> check skVal sk   return $ TypedValue' True val' (ForAll ann ident mbK ty (Just scope))-check' val t@(ConstrainedType _ con@(Constraint _ (Qualified _ (ProperName className)) _ _) ty) = do+check' val t@(ConstrainedType _ con@(Constraint _ (Qualified _ (ProperName className)) _ _ _) ty) = do   dictName <- freshIdent ("dict" <> className)   dicts <- newDictionaries [] (Qualified Nothing dictName) con   val' <- withBindingGroupVisible $ withTypeClassDictionaries dicts $ check val ty@@ -721,14 +723,17 @@   -}   dicts <- getTypeClassDictionaries   hints <- getHints+  con <- checkConstraint (srcConstraint className [] tys Nothing)   return $ TypedValue' False-             (TypeClassDictionary (srcConstraint className tys Nothing) dicts hints)+             (TypeClassDictionary con dicts hints)              ty check' (TypedValue checkType val ty1) ty2 = do-  kind <- kindOf ty1-  checkTypeKind ty1 kind-  ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty1-  ty2' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty2+  (elabTy1, kind1) <- kindOf ty1+  (elabTy2, kind2) <- kindOf ty2+  unifyKinds kind1 kind2+  checkTypeKind ty1 kind1+  ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ elabTy1+  ty2' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ elabTy2   elaborate <- subsumes ty1' ty2'   val' <- if checkType             then tvToExpr <$> check val ty1'@@ -756,12 +761,12 @@   -- We check _obj_ against the type _t_ with the types in _ps_ replaced with unknowns.   let (propsToCheck, rest) = rowToList row       (removedProps, remainingProps) = partition (\(RowListItem _ p _) -> p `elem` map (Label . fst) ps) propsToCheck-  us <- zipWith srcRowListItem (map rowListLabel removedProps) <$> replicateM (length ps) freshType+  us <- zipWith srcRowListItem (map rowListLabel removedProps) <$> replicateM (length ps) (freshTypeWithKind kindType)   obj' <- tvToExpr <$> check obj (srcTypeApp tyRecord (rowFromList (us ++ remainingProps, rest)))   ps' <- checkProperties e ps row True   return $ TypedValue' True (ObjectUpdate obj' ps') t check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do-  rest <- freshType+  rest <- freshTypeWithKind (kindRow kindType)   val' <- tvToExpr <$> check val (srcTypeApp tyRecord (srcRCons (Label prop) ty rest))   return $ TypedValue' True (Accessor prop val') ty check' v@(Constructor _ c) ty = do@@ -804,7 +809,7 @@   convert = fmap (fmap tvToExpr)   (ts', r') = rowToList row   toRowPair (RowListItem _ lbl ty) = (lbl, ty)-  go [] [] (REmpty _) = return []+  go [] [] (REmptyKinded _ _) = return []   go [] [] u@(TUnknown _ _)     | lax = return []     | otherwise = do unifyTypes u srcREmpty@@ -812,12 +817,12 @@   go [] [] Skolem{} | lax = return []   go [] ((p, _): _) _ | lax = return []                       | otherwise = throwError . errorMessage $ PropertyIsMissing p-  go ((p,_):_) [] (REmpty _) = throwError . errorMessage $ AdditionalProperty $ Label p+  go ((p,_):_) [] (REmptyKinded _ _) = throwError . errorMessage $ AdditionalProperty $ Label p   go ((p,v):ps') ts r =     case lookup (Label p) ts of       Nothing -> do         v'@(TypedValue' _ _ ty) <- infer v-        rest <- freshType+        rest <- freshTypeWithKind (kindRow kindType)         unifyTypes r (srcRCons (Label p) ty rest)         ps'' <- go ps' ts rest         return $ (p, v') : ps''@@ -865,8 +870,9 @@   unifyTypes tyFunction' tyFunction   arg' <- tvToExpr <$> check arg argTy   return (retTy, App fn arg')-checkFunctionApplication' fn (ForAll _ ident _ ty _) arg = do-  replaced <- replaceVarWithUnknown ident ty+checkFunctionApplication' fn (ForAll _ ident mbK ty _) arg = do+  u <- maybe (internalCompilerError "Unelaborated forall") freshTypeWithKind mbK+  let replaced = replaceTypeVars ident u ty   checkFunctionApplication fn replaced arg checkFunctionApplication' fn (KindedType _ ty _) arg =   checkFunctionApplication fn ty arg@@ -881,7 +887,7 @@     TypedValue' _ arg' t <- infer arg     (arg'', t') <- instantiatePolyTypeWithUnknowns arg' t     return $ TypedValue' True arg'' t'-  ret <- freshType+  ret <- freshTypeWithKind kindType   unifyTypes u (function ty ret)   return (ret, App fn (tvToExpr tv))
src/Language/PureScript/TypeChecker/Unify.hs view
@@ -5,53 +5,73 @@ -- module Language.PureScript.TypeChecker.Unify   ( freshType+  , freshTypeWithKind   , solveType   , substituteType   , unknownsInType   , unifyTypes   , unifyRows   , alignRowsWith-  , replaceVarWithUnknown   , replaceTypeWildcards   , varIfUnknown   ) where  import Prelude.Compat -import Control.Arrow (first, second) import Control.Monad import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.State.Class (MonadState(..), gets, modify)+import Control.Monad.State.Class (MonadState(..), gets, modify, state) import Control.Monad.Writer.Class (MonadWriter(..))  import Data.Foldable (traverse_)-import Data.Function (on)-import Data.List (sortBy, nubBy) import qualified Data.Map as M-import Data.Ord (comparing)-import Data.Text (Text) import qualified Data.Text as T  import Language.PureScript.Crash+import qualified Language.PureScript.Environment as E import Language.PureScript.Errors+import Language.PureScript.TypeChecker.Kinds (elaborateKind, instantiateKind, unifyKinds) import Language.PureScript.TypeChecker.Monad import Language.PureScript.TypeChecker.Skolems import Language.PureScript.Types --- | Generate a fresh type variable+-- | Generate a fresh type variable with an unknown kind. Avoid this if at all possible. freshType :: (MonadState CheckState m) => m SourceType-freshType = do-  t <- gets checkNextType-  modify $ \st -> st { checkNextType = t + 1 }-  return $ srcTUnknown t+freshType = state $ \st -> do+  let+    t = checkNextType st+    st' = st { checkNextType = t + 2+             , checkSubstitution =+                 (checkSubstitution st) { substUnsolved = M.insert t (UnkLevel (pure t), E.kindType)+                                                        . M.insert (t + 1) (UnkLevel (pure (t + 1)), srcTUnknown t)+                                                        . substUnsolved+                                                        $ checkSubstitution st+                                        }+             }+  (srcTUnknown (t + 1), st') +-- | Generate a fresh type variable with a known kind.+freshTypeWithKind :: (MonadState CheckState m) => SourceType -> m SourceType+freshTypeWithKind kind = state $ \st -> do+  let+    t = checkNextType st+    st' = st { checkNextType = t + 1+             , checkSubstitution =+                 (checkSubstitution st) { substUnsolved = M.insert t (UnkLevel (pure t), kind) (substUnsolved (checkSubstitution st)) }+             }+  (srcTUnknown t, st')+ -- | Update the substitution to solve a type constraint solveType :: (MonadError MultipleErrors m, MonadState CheckState m) => Int -> SourceType -> m () solveType u t = do   occursCheck u t+  k1 <- elaborateKind t+  subst <- gets checkSubstitution+  k2 <- maybe (internalCompilerError ("No kind for unification variable ?" <> T.pack (show u))) (pure . substituteType subst . snd) . M.lookup u . substUnsolved $ subst+  t' <- instantiateKind (t, k1) k2   modify $ \cs -> cs { checkSubstitution =                          (checkSubstitution cs) { substType =-                                                    M.insert u t $ substType $ checkSubstitution cs+                                                    M.insert u t' $ substType $ checkSubstitution cs                                                 }                      } @@ -91,17 +111,17 @@   unifyTypes' (TUnknown _ u1) (TUnknown _ u2) | u1 == u2 = return ()   unifyTypes' (TUnknown _ u) t = solveType u t   unifyTypes' t (TUnknown _ u) = solveType u t-  unifyTypes' (ForAll ann1 ident1 _ ty1 sc1) (ForAll ann2 ident2 _ ty2 sc2) =+  unifyTypes' (ForAll ann1 ident1 mbK1 ty1 sc1) (ForAll ann2 ident2 mbK2 ty2 sc2) =     case (sc1, sc2) of       (Just sc1', Just sc2') -> do         sko <- newSkolemConstant-        let sk1 = skolemize ann1 ident1 sko sc1' ty1-        let sk2 = skolemize ann2 ident2 sko sc2' ty2+        let sk1 = skolemize ann1 ident1 mbK1 sko sc1' ty1+        let sk2 = skolemize ann2 ident2 mbK2 sko sc2' ty2         sk1 `unifyTypes` sk2       _ -> internalError "unifyTypes: unspecified skolem scope"-  unifyTypes' (ForAll ann ident _ ty1 (Just sc)) ty2 = do+  unifyTypes' (ForAll ann ident mbK ty1 (Just sc)) ty2 = do     sko <- newSkolemConstant-    let sk = skolemize ann ident sko sc ty1+    let sk = skolemize ann ident mbK sko sc ty1     sk `unifyTypes` ty2   unifyTypes' ForAll{} _ = internalError "unifyTypes: unspecified skolem scope"   unifyTypes' ty f@ForAll{} = f `unifyTypes` ty@@ -112,13 +132,16 @@   unifyTypes' (TypeApp _ t3 t4) (TypeApp _ t5 t6) = do     t3 `unifyTypes` t5     t4 `unifyTypes` t6-  unifyTypes' (Skolem _ _ s1 _) (Skolem _ _ s2 _) | s1 == s2 = return ()+  unifyTypes' (KindApp _ t3 t4) (KindApp _ t5 t6) = do+    t3 `unifyKinds` t5+    t4 `unifyTypes` t6+  unifyTypes' (Skolem _ _ _ s1 _) (Skolem _ _ _ s2 _) | s1 == s2 = return ()   unifyTypes' (KindedType _ ty1 _) ty2 = ty1 `unifyTypes` ty2   unifyTypes' ty1 (KindedType _ ty2 _) = ty1 `unifyTypes` ty2   unifyTypes' r1@RCons{} r2 = unifyRows r1 r2   unifyTypes' r1 r2@RCons{} = unifyRows r1 r2-  unifyTypes' r1@REmpty{} r2 = unifyRows r1 r2-  unifyTypes' r1 r2@REmpty{} = unifyRows r1 r2+  unifyTypes' r1@REmptyKinded{} r2 = unifyRows r1 r2+  unifyTypes' r1 r2@REmptyKinded{} = unifyRows r1 r2   unifyTypes' (ConstrainedType _ c1 ty1) (ConstrainedType _ c2 ty2)     | constraintClass c1 == constraintClass c2 && constraintData c1 == constraintData c2 = do         traverse_ (uncurry unifyTypes) (constraintArgs c1 `zip` constraintArgs c2)@@ -129,29 +152,6 @@   unifyTypes' t3 t4 =     throwError . errorMessage $ TypesDoNotUnify t3 t4 --- | Align two rows of types, splitting them into three parts:------ * Those types which appear in both rows--- * Those which appear only on the left--- * Those which appear only on the right------ Note: importantly, we preserve the order of the types with a given label.-alignRowsWith-  :: (Type a -> Type a -> r)-  -> Type a-  -> Type a-  -> ([r], (([RowListItem a], Type a), ([RowListItem a], Type a)))-alignRowsWith f ty1 ty2 = go s1 s2 where-  (s1, tail1) = rowToSortedList ty1-  (s2, tail2) = rowToSortedList ty2--  go [] r = ([], (([], tail1), (r, tail2)))-  go r [] = ([], ((r, tail1), ([], tail2)))-  go lhs@(RowListItem a1 l1 t1 : r1) rhs@(RowListItem a2 l2 t2 : r2)-    | l1 < l2 = (second . first . first) (RowListItem a1 l1 t1 :) (go r1 rhs)-    | l2 < l1 = (second . second . first) (RowListItem a2 l2 t2 :) (go lhs r2)-    | otherwise = first (f t1 t2 :) (go r1 r2)- -- | Unify two rows, updating the current substitution -- -- Common labels are identified and unified. Remaining labels and types are unified with a@@ -163,13 +163,13 @@   unifyTails :: ([RowListItem SourceAnn], SourceType) -> ([RowListItem SourceAnn], SourceType) -> m ()   unifyTails ([], TUnknown _ u)    (sd, r)               = solveType u (rowFromList (sd, r))   unifyTails (sd, r)               ([], TUnknown _ u)    = solveType u (rowFromList (sd, r))-  unifyTails ([], REmpty _)        ([], REmpty _)        = return ()+  unifyTails ([], REmptyKinded _ _) ([], REmptyKinded _ _) = return ()   unifyTails ([], TypeVar _ v1)    ([], TypeVar _ v2)    | v1 == v2 = return ()-  unifyTails ([], Skolem _ s1 _ _) ([], Skolem _ s2 _ _) | s1 == s2 = return ()-  unifyTails (sd1, TUnknown _ u1)  (sd2, TUnknown _ u2)  = do+  unifyTails ([], Skolem _ _ s1 _ _) ([], Skolem _ _ s2 _ _) | s1 == s2 = return ()+  unifyTails (sd1, TUnknown a u1)  (sd2, TUnknown _ u2)  = do     forM_ sd1 $ occursCheck u2 . rowListType     forM_ sd2 $ occursCheck u1 . rowListType-    rest' <- freshType+    rest' <- freshTypeWithKind =<< elaborateKind (TUnknown a u1)     solveType u1 (rowFromList (sd2, rest'))     solveType u2 (rowFromList (sd1, rest'))   unifyTails _ _ =@@ -177,14 +177,6 @@       throwError . errorMessage $ TypesDoNotUnify r1 r2  -- |--- Replace a single type variable with a new unification variable----replaceVarWithUnknown :: (MonadState CheckState m) => Text -> SourceType -> m SourceType-replaceVarWithUnknown ident ty = do-  tu <- freshType-  return $ replaceTypeVars ident tu ty---- | -- Replace type wildcards with unknowns -- replaceTypeWildcards :: (MonadWriter MultipleErrors m, MonadState CheckState m) => SourceType -> m SourceType@@ -201,13 +193,13 @@ -- | -- Replace outermost unsolved unification variables with named type variables ---varIfUnknown :: SourceType -> SourceType-varIfUnknown ty =-  let unks = nubBy ((==) `on` snd) $ unknownsInType ty-      toName = T.cons 't' . T.pack .  show-      addKind a = (a, Nothing)-      ty' = everywhereOnTypes typeToVar ty-      typeToVar :: SourceType -> SourceType-      typeToVar (TUnknown ann u) = TypeVar ann (toName u)-      typeToVar t = t-  in mkForAll (fmap (fmap addKind) . sortBy (comparing snd) . fmap (fmap toName) $ unks) ty'+varIfUnknown :: [(Unknown, SourceType)] -> SourceType -> SourceType+varIfUnknown unks ty =+  mkForAll (toBinding <$> unks) $ go ty+  where+  toName = T.cons 't' . T.pack .  show+  toBinding (a, k) = (getAnnForType ty, (toName a, Just $ go k))+  go = everywhereOnTypes $ \case+    (TUnknown ann u)+      | Just _ <- lookup u unks -> TypeVar ann (toName u)+    t -> t
− src/Language/PureScript/TypeClassDictionaries.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE DeriveFoldable    #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveGeneric     #-}-module Language.PureScript.TypeClassDictionaries where--import Prelude.Compat--import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import Data.Text (Text, pack)--import Language.PureScript.Names-import Language.PureScript.Types---- |--- Data representing a type class dictionary which is in scope----data TypeClassDictionaryInScope v-  = TypeClassDictionaryInScope {-    -- | The instance chain-      tcdChain :: [Qualified Ident]-    -- | Index of the instance chain-    , tcdIndex :: Integer-    -- | The value with which the dictionary can be accessed at runtime-    , tcdValue :: v-    -- | How to obtain this instance via superclass relationships-    , tcdPath :: [(Qualified (ProperName 'ClassName), Integer)]-    -- | The name of the type class to which this type class instance applies-    , tcdClassName :: Qualified (ProperName 'ClassName)-    -- | The types to which this type class instance applies-    , tcdInstanceTypes :: [SourceType]-    -- | Type class dependencies which must be satisfied to construct this dictionary-    , tcdDependencies :: Maybe [SourceConstraint]-    }-    deriving (Show, Functor, Foldable, Traversable, Generic)--instance NFData v => NFData (TypeClassDictionaryInScope v)--type NamedDict = TypeClassDictionaryInScope (Qualified Ident)---- | Generate a name for a superclass reference which can be used in--- generated code.-superclassName :: Qualified (ProperName 'ClassName) -> Integer -> Text-superclassName pn index = runProperName (disqualify pn) <> pack (show index)
− src/Language/PureScript/Types.hs 
@@ -1,647 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleInstances #-}---- |--- Data types for types----module Language.PureScript.Types where--import Prelude.Compat-import Protolude (ordNub)--import Codec.Serialise (Serialise)-import Control.Applicative ((<|>))-import Control.Arrow (first)-import Control.DeepSeq (NFData)-import Control.Monad ((<=<))-import Data.Aeson ((.:), (.=))-import qualified Data.Aeson as A-import qualified Data.Aeson.Types as A-import Data.Foldable (fold)-import Data.List (sortBy)-import Data.Ord (comparing)-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import qualified Data.Text as T-import GHC.Generics (Generic)--import Language.PureScript.AST.SourcePos-import Language.PureScript.Kinds-import Language.PureScript.Names-import Language.PureScript.Label (Label)-import Language.PureScript.PSString (PSString)--import Lens.Micro.Platform (Lens', (^.), set)--type SourceType = Type SourceAnn-type SourceConstraint = Constraint SourceAnn---- |--- An identifier for the scope of a skolem variable----newtype SkolemScope = SkolemScope { runSkolemScope :: Int }-  deriving (Show, Eq, Ord, A.ToJSON, A.FromJSON, Generic)--instance NFData SkolemScope-instance Serialise SkolemScope---- |--- The type of types----data Type a-  -- | A unification variable of type Type-  = TUnknown a Int-  -- | A named type variable-  | TypeVar a Text-  -- | A type-level string-  | TypeLevelString a PSString-  -- | A type wildcard, as would appear in a partial type synonym-  | TypeWildcard a (Maybe Text)-  -- | A type constructor-  | TypeConstructor a (Qualified (ProperName 'TypeName))-  -- | A type operator. This will be desugared into a type constructor during the-  -- "operators" phase of desugaring.-  | TypeOp a (Qualified (OpName 'TypeOpName))-  -- | A type application-  | TypeApp a (Type a) (Type a)-  -- | Forall quantifier-  | ForAll a Text (Maybe (Kind a)) (Type a) (Maybe SkolemScope)-  -- | A type with a set of type class constraints-  | ConstrainedType a (Constraint a) (Type a)-  -- | A skolem constant-  | Skolem a Text Int SkolemScope-  -- | An empty row-  | REmpty a-  -- | A non-empty row-  | RCons a Label (Type a) (Type a)-  -- | A type with a kind annotation-  | KindedType a (Type a) (Kind a)-  -- | Binary operator application. During the rebracketing phase of desugaring,-  -- this data constructor will be removed.-  | BinaryNoParensType a (Type a) (Type a) (Type a)-  -- | Explicit parentheses. During the rebracketing phase of desugaring, this-  -- data constructor will be removed.-  ---  -- Note: although it seems this constructor is not used, it _is_ useful,-  -- since it prevents certain traversals from matching.-  | ParensInType a (Type a)-  deriving (Show, Generic, Functor, Foldable, Traversable)--instance NFData a => NFData (Type a)-instance Serialise a => Serialise (Type a)--srcTUnknown :: Int -> SourceType-srcTUnknown = TUnknown NullSourceAnn--srcTypeVar :: Text -> SourceType-srcTypeVar = TypeVar NullSourceAnn--srcTypeLevelString :: PSString -> SourceType-srcTypeLevelString = TypeLevelString NullSourceAnn--srcTypeWildcard :: SourceType-srcTypeWildcard = TypeWildcard NullSourceAnn Nothing--srcTypeConstructor :: Qualified (ProperName 'TypeName) -> SourceType-srcTypeConstructor = TypeConstructor NullSourceAnn--srcTypeOp :: Qualified (OpName 'TypeOpName) -> SourceType-srcTypeOp = TypeOp NullSourceAnn--srcTypeApp :: SourceType -> SourceType -> SourceType-srcTypeApp = TypeApp NullSourceAnn--srcForAll :: Text -> Maybe SourceKind -> SourceType -> Maybe SkolemScope -> SourceType-srcForAll = ForAll NullSourceAnn--srcConstrainedType :: SourceConstraint -> SourceType -> SourceType-srcConstrainedType = ConstrainedType NullSourceAnn--srcSkolem :: Text -> Int -> SkolemScope -> SourceType-srcSkolem = Skolem NullSourceAnn--srcREmpty :: SourceType-srcREmpty = REmpty NullSourceAnn--srcRCons :: Label -> SourceType -> SourceType -> SourceType-srcRCons = RCons NullSourceAnn--srcKindedType :: SourceType -> SourceKind -> SourceType-srcKindedType = KindedType NullSourceAnn--srcBinaryNoParensType :: SourceType -> SourceType -> SourceType -> SourceType-srcBinaryNoParensType = BinaryNoParensType NullSourceAnn--srcParensInType :: SourceType -> SourceType-srcParensInType = ParensInType NullSourceAnn---- | Additional data relevant to type class constraints-data ConstraintData-  = PartialConstraintData [[Text]] Bool-  -- ^ Data to accompany a Partial constraint generated by the exhaustivity checker.-  -- It contains (rendered) binder information for those binders which were-  -- not matched, and a flag indicating whether the list was truncated or not.-  -- Note: we use 'Text' here because using 'Binder' would introduce a cyclic-  -- dependency in the module graph.-  deriving (Show, Eq, Ord, Generic)--instance NFData ConstraintData-instance Serialise ConstraintData---- | A typeclass constraint-data Constraint a = Constraint-  { constraintAnn :: a-  -- ^ constraint annotation-  , constraintClass :: Qualified (ProperName 'ClassName)-  -- ^ constraint class name-  , constraintArgs  :: [Type a]-  -- ^ type arguments-  , constraintData  :: Maybe ConstraintData-  -- ^ additional data relevant to this constraint-  } deriving (Show, Generic, Functor, Foldable, Traversable)--instance NFData a => NFData (Constraint a)-instance Serialise a => Serialise (Constraint a)--srcConstraint :: Qualified (ProperName 'ClassName) -> [SourceType] -> Maybe ConstraintData -> SourceConstraint-srcConstraint = Constraint NullSourceAnn--mapConstraintArgs :: ([Type a] -> [Type a]) -> Constraint a -> Constraint a-mapConstraintArgs f c = c { constraintArgs = f (constraintArgs c) }--overConstraintArgs :: Functor f => ([Type a] -> f [Type a]) -> Constraint a -> f (Constraint a)-overConstraintArgs f c = (\args -> c { constraintArgs = args }) <$> f (constraintArgs c)--constraintDataToJSON :: ConstraintData -> A.Value-constraintDataToJSON (PartialConstraintData bs trunc) =-  A.object-    [ "contents" .= (bs, trunc)-    ]--constraintToJSON :: (a -> A.Value) -> Constraint a -> A.Value-constraintToJSON annToJSON (Constraint {..}) =-  A.object-    [ "constraintAnn"   .= annToJSON constraintAnn-    , "constraintClass" .= constraintClass-    , "constraintArgs"  .= fmap (typeToJSON annToJSON) constraintArgs-    , "constraintData"  .= fmap constraintDataToJSON constraintData-    ]--typeToJSON :: forall a. (a -> A.Value) -> Type a -> A.Value-typeToJSON annToJSON ty =-  case ty of-    TUnknown a b ->-      variant "TUnknown" a b-    TypeVar a b ->-      variant "TypeVar" a b-    TypeLevelString a b ->-      variant "TypeLevelString" a b-    TypeWildcard a b ->-      variant "TypeWildcard" a b-    TypeConstructor a b ->-      variant "TypeConstructor" a b-    TypeOp a b ->-      variant "TypeOp" a b-    TypeApp a b c ->-      variant "TypeApp" a (go b, go c)-    ForAll a b c d e ->-      case c of-        Nothing -> variant "ForAll" a (b, go d, e)-        Just k -> variant "ForAll" a (b, kindToJSON annToJSON k, go d, e)-    ConstrainedType a b c ->-      variant "ConstrainedType" a (constraintToJSON annToJSON b, go c)-    Skolem a b c d ->-      variant "Skolem" a (b, c, d)-    REmpty a ->-      nullary "REmpty" a-    RCons a b c d ->-      variant "RCons" a (b, go c, go d)-    KindedType a b c ->-      variant "KindedType" a (go b, kindToJSON annToJSON c)-    BinaryNoParensType a b c d ->-      variant "BinaryNoParensType" a (go b, go c, go d)-    ParensInType a b ->-      variant "ParensInType" a (go b)-  where-  go :: Type a -> A.Value-  go = typeToJSON annToJSON--  variant :: A.ToJSON b => String -> a -> b -> A.Value-  variant tag ann contents =-    A.object-      [ "tag"        .= tag-      , "annotation" .= annToJSON ann-      , "contents"   .= contents-      ]--  nullary :: String -> a -> A.Value-  nullary tag ann =-    A.object-      [ "tag"        .= tag-      , "annotation" .= annToJSON ann-      ]--instance A.ToJSON a => A.ToJSON (Type a) where-  toJSON = typeToJSON A.toJSON--instance A.ToJSON a => A.ToJSON (Constraint a) where-  toJSON = constraintToJSON A.toJSON--instance A.ToJSON ConstraintData where-  toJSON = constraintDataToJSON--constraintDataFromJSON :: A.Value -> A.Parser ConstraintData-constraintDataFromJSON = A.withObject "PartialConstraintData" $ \o -> do-  (bs, trunc) <- o .: "contents"-  pure $ PartialConstraintData bs trunc--constraintFromJSON :: forall a. A.Parser a -> (A.Value -> A.Parser a) -> A.Value -> A.Parser (Constraint a)-constraintFromJSON defaultAnn annFromJSON = A.withObject "Constraint" $ \o -> do-  constraintAnn   <- (o .: "constraintAnn" >>= annFromJSON) <|> defaultAnn-  constraintClass <- o .: "constraintClass"-  constraintArgs  <- o .: "constraintArgs" >>= traverse (typeFromJSON defaultAnn annFromJSON)-  constraintData  <- o .: "constraintData" >>= traverse constraintDataFromJSON-  pure $ Constraint {..}--typeFromJSON :: forall a. A.Parser a -> (A.Value -> A.Parser a) -> A.Value -> A.Parser (Type a)-typeFromJSON defaultAnn annFromJSON = A.withObject "Type" $ \o -> do-  tag <- o .: "tag"-  a   <- (o .: "annotation" >>= annFromJSON) <|> defaultAnn-  let-    contents :: A.FromJSON b => A.Parser b-    contents = o .: "contents"-  case tag of-    "TUnknown" ->-      TUnknown a <$> contents-    "TypeVar" ->-      TypeVar a <$> contents-    "TypeLevelString" ->-      TypeLevelString a <$> contents-    "TypeWildcard" -> do-      b <- contents <|> pure Nothing-      pure $ TypeWildcard a b-    "TypeConstructor" ->-      TypeConstructor a <$> contents-    "TypeOp" ->-      TypeOp a <$> contents-    "TypeApp" -> do-      (b, c) <- contents-      TypeApp a <$> go b <*> go c-    "ForAll" -> do-      let-        withoutMbKind = do-          (b, c, d) <- contents-          ForAll a b Nothing <$> go c <*> pure d-        withMbKind = do-          (b, c, d, e) <- contents-          ForAll a b <$> (Just <$> kindFromJSON defaultAnn annFromJSON c) <*> go d <*> pure e-      withMbKind <|> withoutMbKind-    "ConstrainedType" -> do-      (b, c) <- contents-      ConstrainedType a <$> constraintFromJSON defaultAnn annFromJSON b <*> go c-    "Skolem" -> do-      (b, c, d) <- contents-      pure $ Skolem a b c d-    "REmpty" ->-      pure $ REmpty a-    "RCons" -> do-      (b, c, d) <- contents-      RCons a b <$> go c <*> go d-    "KindedType" -> do-      (b, c) <- contents-      KindedType a <$> go b <*> kindFromJSON defaultAnn annFromJSON c-    "BinaryNoParensType" -> do-      (b, c, d) <- contents-      BinaryNoParensType a <$> go b <*> go c <*> go d-    "ParensInType" -> do-      b <- contents-      ParensInType a <$> go b-    other ->-      fail $ "Unrecognised tag: " ++ other-  where-  go :: A.Value -> A.Parser (Type a)-  go = typeFromJSON defaultAnn annFromJSON---- These overlapping instances exist to preserve compatibility for common--- instances which have a sensible default for missing annotations.-instance {-# OVERLAPPING #-} A.FromJSON (Type SourceAnn) where-  parseJSON = typeFromJSON (pure NullSourceAnn) A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON (Type ()) where-  parseJSON = typeFromJSON (pure ()) A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON a => A.FromJSON (Type a) where-  parseJSON = typeFromJSON (fail "Invalid annotation") A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON (Constraint SourceAnn) where-  parseJSON = constraintFromJSON (pure NullSourceAnn) A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON (Constraint ()) where-  parseJSON = constraintFromJSON (pure ()) A.parseJSON--instance {-# OVERLAPPING #-} A.FromJSON a => A.FromJSON (Constraint a) where-  parseJSON = constraintFromJSON (fail "Invalid annotation") A.parseJSON--instance A.FromJSON ConstraintData where-  parseJSON = constraintDataFromJSON--data RowListItem a = RowListItem-  { rowListAnn :: a-  , rowListLabel :: Label-  , rowListType :: Type a-  } deriving (Show, Generic, Functor, Foldable, Traversable)--srcRowListItem :: Label -> SourceType -> RowListItem SourceAnn-srcRowListItem = RowListItem NullSourceAnn---- | Convert a row to a list of pairs of labels and types-rowToList :: Type a -> ([RowListItem a], Type a)-rowToList = go where-  go (RCons ann name ty row) =-    first (RowListItem ann name ty :) (rowToList row)-  go r = ([], r)---- | Convert a row to a list of pairs of labels and types, sorted by the labels.-rowToSortedList :: Type a -> ([RowListItem a], Type a)-rowToSortedList = first (sortBy (comparing rowListLabel)) . rowToList---- | Convert a list of labels and types to a row-rowFromList :: ([RowListItem a], Type a) -> Type a-rowFromList (xs, r) = foldr (\(RowListItem ann name ty) -> RCons ann name ty) r xs---- | Check whether a type is a monotype-isMonoType :: Type a -> Bool-isMonoType ForAll{} = False-isMonoType (ParensInType _ t) = isMonoType t-isMonoType (KindedType _ t _) = isMonoType t-isMonoType _        = True---- | Universally quantify a type-mkForAll :: [(a, (Text, Maybe (Kind a)))] -> Type a -> Type a-mkForAll args ty = foldl (\t (ann, (arg, mbK)) -> ForAll ann arg mbK t Nothing) ty args---- | Replace a type variable, taking into account variable shadowing-replaceTypeVars :: Text -> Type a -> Type a -> Type a-replaceTypeVars v r = replaceAllTypeVars [(v, r)]---- | Replace named type variables with types-replaceAllTypeVars :: [(Text, Type a)] -> Type a -> Type a-replaceAllTypeVars = go [] where-  go :: [Text] -> [(Text, Type a)] -> Type a -> Type a-  go _  m (TypeVar ann v) = fromMaybe (TypeVar ann v) (v `lookup` m)-  go bs m (TypeApp ann t1 t2) = TypeApp ann (go bs m t1) (go bs m t2)-  go bs m f@(ForAll ann v mbK t sco)-    | v `elem` keys = go bs (filter ((/= v) . fst) m) f-    | v `elem` usedVars =-      let v' = genName v (keys ++ bs ++ usedVars)-          t' = go bs [(v, TypeVar ann v')] t-      in ForAll ann v' mbK (go (v' : bs) m t') sco-    | otherwise = ForAll ann v mbK (go (v : bs) m t) sco-    where-      keys = map fst m-      usedVars = concatMap (usedTypeVariables . snd) m-  go bs m (ConstrainedType ann c t) = ConstrainedType ann (mapConstraintArgs (map (go bs m)) c) (go bs m t)-  go bs m (RCons ann name' t r) = RCons ann name' (go bs m t) (go bs m r)-  go bs m (KindedType ann t k) = KindedType ann (go bs m t) k-  go bs m (BinaryNoParensType ann t1 t2 t3) = BinaryNoParensType ann (go bs m t1) (go bs m t2) (go bs m t3)-  go bs m (ParensInType ann t) = ParensInType ann (go bs m t)-  go _  _ ty = ty--  genName orig inUse = try' 0 where-    try' :: Integer -> Text-    try' n | (orig <> T.pack (show n)) `elem` inUse = try' (n + 1)-           | otherwise = orig <> T.pack (show n)---- | Collect all type variables appearing in a type-usedTypeVariables :: Type a -> [Text]-usedTypeVariables = ordNub . everythingOnTypes (++) go where-  go (TypeVar _ v) = [v]-  go _ = []---- | Collect all free type variables appearing in a type-freeTypeVariables :: Type a -> [Text]-freeTypeVariables = ordNub . go [] where-  go :: [Text] -> Type a -> [Text]-  go bound (TypeVar _ v) | v `notElem` bound = [v]-  go bound (TypeApp _ t1 t2) = go bound t1 ++ go bound t2-  go bound (ForAll _ v _ t _) = go (v : bound) t-  go bound (ConstrainedType _ c t) = concatMap (go bound) (constraintArgs c) ++ go bound t-  go bound (RCons _ _ t r) = go bound t ++ go bound r-  go bound (KindedType _ t _) = go bound t-  go bound (BinaryNoParensType _ t1 t2 t3) = go bound t1 ++ go bound t2 ++ go bound t3-  go bound (ParensInType _ t) = go bound t-  go _ _ = []---- | Universally quantify over all type variables appearing free in a type-quantify :: Type a -> Type a-quantify ty = foldr (\arg t -> ForAll (getAnnForType ty) arg Nothing t Nothing) ty $ freeTypeVariables ty---- | Move all universal quantifiers to the front of a type-moveQuantifiersToFront :: Type a -> Type a-moveQuantifiersToFront = go [] [] where-  go qs cs (ForAll ann q mbK ty sco) = go ((ann, q, sco, mbK) : qs) cs ty-  go qs cs (ConstrainedType ann c ty) = go qs ((ann, c) : cs) ty-  go qs cs ty = foldl (\ty' (ann, q, sco, mbK) -> ForAll ann q mbK ty' sco) (foldl (\ty' (ann, c) -> ConstrainedType ann c ty') ty cs) qs---- | Check if a type contains wildcards-containsWildcards :: Type a -> Bool-containsWildcards = everythingOnTypes (||) go where-  go :: Type a -> Bool-  go TypeWildcard{} = True-  go _ = False---- | Check if a type contains `forall`-containsForAll :: Type a -> Bool-containsForAll = everythingOnTypes (||) go where-  go :: Type a -> Bool-  go ForAll{} = True-  go _ = False--everywhereOnTypes :: (Type a -> Type a) -> Type a -> Type a-everywhereOnTypes f = go where-  go (TypeApp ann t1 t2) = f (TypeApp ann (go t1) (go t2))-  go (ForAll ann arg mbK ty sco) = f (ForAll ann arg mbK (go ty) sco)-  go (ConstrainedType ann c ty) = f (ConstrainedType ann (mapConstraintArgs (map go) c) (go ty))-  go (RCons ann name ty rest) = f (RCons ann name (go ty) (go rest))-  go (KindedType ann ty k) = f (KindedType ann (go ty) k)-  go (BinaryNoParensType ann t1 t2 t3) = f (BinaryNoParensType ann (go t1) (go t2) (go t3))-  go (ParensInType ann t) = f (ParensInType ann (go t))-  go other = f other--everywhereOnTypesTopDown :: (Type a -> Type a) -> Type a -> Type a-everywhereOnTypesTopDown f = go . f where-  go (TypeApp ann t1 t2) = TypeApp ann (go (f t1)) (go (f t2))-  go (ForAll ann arg mbK ty sco) = ForAll ann arg mbK (go (f ty)) sco-  go (ConstrainedType ann c ty) = ConstrainedType ann (mapConstraintArgs (map (go . f)) c) (go (f ty))-  go (RCons ann name ty rest) = RCons ann name (go (f ty)) (go (f rest))-  go (KindedType ann ty k) = KindedType ann (go (f ty)) k-  go (BinaryNoParensType ann t1 t2 t3) = BinaryNoParensType ann (go (f t1)) (go (f t2)) (go (f t3))-  go (ParensInType ann t) = ParensInType ann (go (f t))-  go other = f other--everywhereOnTypesM :: Monad m => (Type a -> m (Type a)) -> Type a -> m (Type a)-everywhereOnTypesM f = go where-  go (TypeApp ann t1 t2) = (TypeApp ann <$> go t1 <*> go t2) >>= f-  go (ForAll ann arg mbK ty sco) = (ForAll ann arg mbK <$> go ty <*> pure sco) >>= f-  go (ConstrainedType ann c ty) = (ConstrainedType ann <$> overConstraintArgs (mapM go) c <*> go ty) >>= f-  go (RCons ann name ty rest) = (RCons ann name <$> go ty <*> go rest) >>= f-  go (KindedType ann ty k) = (KindedType ann <$> go ty <*> pure k) >>= f-  go (BinaryNoParensType ann t1 t2 t3) = (BinaryNoParensType ann <$> go t1 <*> go t2 <*> go t3) >>= f-  go (ParensInType ann t) = (ParensInType ann <$> go t) >>= f-  go other = f other--everywhereOnTypesTopDownM :: Monad m => (Type a -> m (Type a)) -> Type a -> m (Type a)-everywhereOnTypesTopDownM f = go <=< f where-  go (TypeApp ann t1 t2) = TypeApp ann <$> (f t1 >>= go) <*> (f t2 >>= go)-  go (ForAll ann arg mbK ty sco) = ForAll ann arg mbK <$> (f ty >>= go) <*> pure sco-  go (ConstrainedType ann c ty) = ConstrainedType ann <$> overConstraintArgs (mapM (go <=< f)) c <*> (f ty >>= go)-  go (RCons ann name ty rest) = RCons ann name <$> (f ty >>= go) <*> (f rest >>= go)-  go (KindedType ann ty k) = KindedType ann <$> (f ty >>= go) <*> pure k-  go (BinaryNoParensType ann t1 t2 t3) = BinaryNoParensType ann <$> (f t1 >>= go) <*> (f t2 >>= go) <*> (f t3 >>= go)-  go (ParensInType ann t) = ParensInType ann <$> (f t >>= go)-  go other = f other--everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r-everythingOnTypes (<+>) f = go where-  go t@(TypeApp _ t1 t2) = f t <+> go t1 <+> go t2-  go t@(ForAll _ _ _ ty _) = f t <+> go ty-  go t@(ConstrainedType _ c ty) = foldl (<+>) (f t) (map go (constraintArgs c)) <+> go ty-  go t@(RCons _ _ ty rest) = f t <+> go ty <+> go rest-  go t@(KindedType _ ty _) = f t <+> go ty-  go t@(BinaryNoParensType _ t1 t2 t3) = f t <+> go t1 <+> go t2 <+> go t3-  go t@(ParensInType _ t1) = f t <+> go t1-  go other = f other--everythingWithContextOnTypes :: s -> r -> (r -> r -> r) -> (s -> Type a -> (s, r)) -> Type a -> r-everythingWithContextOnTypes s0 r0 (<+>) f = go' s0 where-  go' s t = let (s', r) = f s t in r <+> go s' t-  go s (TypeApp _ t1 t2) = go' s t1 <+> go' s t2-  go s (ForAll _ _ _ ty _) = go' s ty-  go s (ConstrainedType _ c ty) = foldl (<+>) r0 (map (go' s) (constraintArgs c)) <+> go' s ty-  go s (RCons _ _ ty rest) = go' s ty <+> go' s rest-  go s (KindedType _ ty _) = go' s ty-  go s (BinaryNoParensType _ t1 t2 t3) = go' s t1 <+> go' s t2 <+> go' s t3-  go s (ParensInType _ t1) = go' s t1-  go _ _ = r0--annForType :: Lens' (Type a) a-annForType k (TUnknown a b) = (\z -> TUnknown z b) <$> k a-annForType k (TypeVar a b) = (\z -> TypeVar z b) <$> k a-annForType k (TypeLevelString a b) = (\z -> TypeLevelString z b) <$> k a-annForType k (TypeWildcard a b) = (\z -> TypeWildcard z b) <$> k a-annForType k (TypeConstructor a b) = (\z -> TypeConstructor z b) <$> k a-annForType k (TypeOp a b) = (\z -> TypeOp z b) <$> k a-annForType k (TypeApp a b c) = (\z -> TypeApp z b c) <$> k a-annForType k (ForAll a b c d e) = (\z -> ForAll z b c d e) <$> k a-annForType k (ConstrainedType a b c) = (\z -> ConstrainedType z b c) <$> k a-annForType k (Skolem a b c d) = (\z -> Skolem z b c d) <$> k a-annForType k (REmpty a) = REmpty <$> k a-annForType k (RCons a b c d) = (\z -> RCons z b c d) <$> k a-annForType k (KindedType a b c) = (\z -> KindedType z b c) <$> k a-annForType k (BinaryNoParensType a b c d) = (\z -> BinaryNoParensType z b c d) <$> k a-annForType k (ParensInType a b) = (\z -> ParensInType z b) <$> k a--getAnnForType :: Type a -> a-getAnnForType = (^. annForType)--setAnnForType :: a -> Type a -> Type a-setAnnForType = set annForType--instance Eq (Type a) where-  (==) = eqType--instance Ord (Type a) where-  compare = compareType--eqType :: Type a -> Type b -> Bool-eqType (TUnknown _ a) (TUnknown _ a') = a == a'-eqType (TypeVar _ a) (TypeVar _ a') = a == a'-eqType (TypeLevelString _ a) (TypeLevelString _ a') = a == a'-eqType (TypeWildcard _ a) (TypeWildcard _ a') = a == a'-eqType (TypeConstructor _ a) (TypeConstructor _ a') = a == a'-eqType (TypeOp _ a) (TypeOp _ a') = a == a'-eqType (TypeApp _ a b) (TypeApp _ a' b') = eqType a a' && eqType b b'-eqType (ForAll _ a b c d) (ForAll _ a' b' c' d') = a == a' && eqMaybeKind b b' && eqType c c' && d == d'-eqType (ConstrainedType _ a b) (ConstrainedType _ a' b') = eqConstraint a a' && eqType b b'-eqType (Skolem _ a b c) (Skolem _ a' b' c') = a == a' && b == b' && c == c'-eqType (REmpty _) (REmpty _) = True-eqType (RCons _ a b c) (RCons _ a' b' c') = a == a' && eqType b b' && eqType c c'-eqType (KindedType _ a b) (KindedType _ a' b') = eqType a a' && eqKind b b'-eqType (BinaryNoParensType _ a b c) (BinaryNoParensType _ a' b' c') = eqType a a' && eqType b b' && eqType c c'-eqType (ParensInType _ a) (ParensInType _ a') = eqType a a'-eqType _ _ = False--compareType :: Type a -> Type b -> Ordering-compareType (TUnknown _ a) (TUnknown _ a') = compare a a'-compareType (TUnknown {}) _ = LT--compareType (TypeVar _ a) (TypeVar _ a') = compare a a'-compareType (TypeVar {}) _ = LT-compareType _ (TypeVar {}) = GT--compareType (TypeLevelString _ a) (TypeLevelString _ a') = compare a a'-compareType (TypeLevelString {}) _ = LT-compareType _ (TypeLevelString {}) = GT--compareType (TypeWildcard _ a) (TypeWildcard _ a') = compare a a'-compareType (TypeWildcard {}) _ = LT-compareType _ (TypeWildcard {}) = GT--compareType (TypeConstructor _ a) (TypeConstructor _ a') = compare a a'-compareType (TypeConstructor {}) _ = LT-compareType _ (TypeConstructor {}) = GT--compareType (TypeOp _ a) (TypeOp _ a') = compare a a'-compareType (TypeOp {}) _ = LT-compareType _ (TypeOp {}) = GT--compareType (TypeApp _ a b) (TypeApp _ a' b') = compareType a a' <> compareType b b'-compareType (TypeApp {}) _ = LT-compareType _ (TypeApp {}) = GT--compareType (ForAll _ a b c d) (ForAll _ a' b' c' d') = compare a a' <> compareMaybeKind b b' <> compareType c c' <> compare d d'-compareType (ForAll {}) _ = LT-compareType _ (ForAll {}) = GT--compareType (ConstrainedType _ a b) (ConstrainedType _ a' b') = compareConstraint a a' <> compareType b b'-compareType (ConstrainedType {}) _ = LT-compareType _ (ConstrainedType {}) = GT--compareType (Skolem _ a b c) (Skolem _ a' b' c') = compare a a' <> compare b b' <> compare c c'-compareType (Skolem {}) _ = LT-compareType _ (Skolem {}) = GT--compareType (REmpty _) (REmpty _) = EQ-compareType (REmpty _) _ = LT-compareType _ (REmpty _) = GT--compareType (RCons _ a b c) (RCons _ a' b' c') = compare a a' <> compareType b b' <> compareType c c'-compareType (RCons {}) _ = LT-compareType _ (RCons {}) = GT--compareType (KindedType _ a b) (KindedType _ a' b') = compareType a a' <> compareKind b b'-compareType (KindedType {}) _ = LT-compareType _ (KindedType {}) = GT--compareType (BinaryNoParensType _ a b c) (BinaryNoParensType _ a' b' c') = compareType a a' <> compareType b b' <> compareType c c'-compareType (BinaryNoParensType {}) _ = LT-compareType _ (BinaryNoParensType {}) = GT--compareType (ParensInType _ a) (ParensInType _ a') = compareType a a'-compareType (ParensInType {}) _ = GT--instance Eq (Constraint a) where-  (==) = eqConstraint--instance Ord (Constraint a) where-  compare = compareConstraint--eqConstraint :: Constraint a -> Constraint b -> Bool-eqConstraint (Constraint _ a b c) (Constraint _ a' b' c') = a == a' && and (zipWith eqType b b') && c == c'--compareConstraint :: Constraint a -> Constraint b -> Ordering-compareConstraint (Constraint _ a b c) (Constraint _ a' b' c') = compare a a' <> fold (zipWith compareType b b') <> compare c c'
stack.yaml view
@@ -2,6 +2,8 @@ pvp-bounds: upper packages: - '.'+- lib/purescript-ast+- lib/purescript-cst extra-deps: - serialise-0.2.2.0 - cborg-0.2.2.0
tests/Language/PureScript/Ide/CompletionSpec.hs view
@@ -9,6 +9,7 @@ import Language.PureScript.Ide.Test as Test import Language.PureScript.Ide.Command as Command import Language.PureScript.Ide.Completion+import qualified Language.PureScript.Ide.Filter.Declaration as DeclarationType import Language.PureScript.Ide.Types import Test.Hspec import System.FilePath@@ -86,3 +87,66 @@                   , typ "member"                   ]     result `shouldSatisfy` \res -> complDocumentation res == Just "doc for member\n"++  it "includes declarationType in completions for values" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "exampleValue"+                  ]+    result `shouldSatisfy` \res ->+      complDeclarationType res == Just DeclarationType.Value++  it "includes declarationType in completions for functions" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "exampleFunction"+                  ]+    result `shouldSatisfy` \res ->+      complDeclarationType res == Just DeclarationType.Value++  it "includes declarationType in completions for inferred values" $ do+    ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "exampleInferredString"+                  ]+    result `shouldSatisfy` \res ->+      complDeclarationType res == Just DeclarationType.Value++  it "includes declarationType in completions for operators" $ do+    ([_, (Right (CompletionResult results))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "\\°/"+                  ]+    length results `shouldBe` 2+    results `shouldSatisfy` any (\res ->+      complDeclarationType res == Just DeclarationType.ValueOperator)+    results `shouldSatisfy` any (\res ->+      complDeclarationType res == Just DeclarationType.TypeOperator)++  it "includes declarationType in completions for type constructors with \+      \conflicting names" $ do+    ([_, (Right (CompletionResult results))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "ExampleTypeConstructor"+                  ]+    length results `shouldBe` 2+    results `shouldSatisfy` any (\res ->+        complDeclarationType res == Just DeclarationType.DataConstructor)+    results `shouldSatisfy` any (\res ->+        complDeclarationType res == Just DeclarationType.Type)++  it "includes declarationType in completions for type classes" $ do+    ([_, (Right (CompletionResult [result]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "ExampleClass"+                  ]+    result `shouldSatisfy` \res ->+      complDeclarationType res == Just DeclarationType.TypeClass++  it "includes declarationType in completions for type class members" $ do+    ([_, (Right (CompletionResult [result]))], _) <- Test.inProject $+      Test.runIde [ load ["CompletionSpec"]+                  , typ "exampleMember"+                  ]+    result `shouldSatisfy` \res ->+      complDeclarationType res == Just DeclarationType.Value
tests/Language/PureScript/Ide/FilterSpec.hs view
@@ -18,7 +18,7 @@ moduleA = (P.moduleNameFromString "Module.A", [T.ideValue "function1" Nothing]) moduleB = (P.moduleNameFromString "Module.B", [T.ideValue "data1" Nothing]) moduleC = (P.moduleNameFromString "Module.C", [T.ideType "List" Nothing []])-moduleD = (P.moduleNameFromString "Module.D", [T.ideKind "kind1"])+moduleD = (P.moduleNameFromString "Module.D", [T.ideType "kind1" Nothing []]) moduleE = (P.moduleNameFromString "Module.E", [T.ideSynonym "SFType" Nothing Nothing `annLoc` synonymSS]) moduleF = (P.moduleNameFromString "Module.F", [T.ideDtor "DtorA" "TypeA" Nothing]) moduleG = (P.moduleNameFromString "Module.G", [T.ideTypeClass "MyClass" P.kindType []])@@ -79,27 +79,9 @@     it "extracts no modules by filtering `type` namespaces" $       runNamespace (Set.fromList [IdeNSType])         [moduleA, moduleB] `shouldBe` []-    it "extracts modules by filtering `kind` namespaces" $-      runNamespace (Set.fromList [IdeNSKind])-        [moduleA, moduleB, moduleD] `shouldBe` [moduleD]-    it "extracts no modules by filtering `kind` namespaces" $-      runNamespace (Set.fromList [IdeNSKind])-        [moduleA, moduleB] `shouldBe` []     it "extracts modules by filtering `value` and `type` namespaces" $       runNamespace (Set.fromList [ IdeNSValue, IdeNSType])         [moduleA, moduleB, moduleC, moduleD]-        `shouldBe` [moduleA, moduleB, moduleC]-    it "extracts modules by filtering `value` and `kind` namespaces" $-      runNamespace (Set.fromList [ IdeNSValue, IdeNSKind])-        [moduleA, moduleB, moduleC, moduleD]-        `shouldBe` [moduleA, moduleB, moduleD]-    it "extracts modules by filtering `type` and `kind` namespaces" $-      runNamespace (Set.fromList [ IdeNSType, IdeNSKind])-        [moduleA, moduleB, moduleC, moduleD]-        `shouldBe` [moduleC, moduleD]-    it "extracts modules by filtering `value`, `type` and `kind` namespaces" $-      runNamespace (Set.fromList [ IdeNSValue, IdeNSType, IdeNSKind])-        [moduleA, moduleB, moduleC, moduleD]         `shouldBe` [moduleA, moduleB, moduleC, moduleD]   describe "declarationTypeFilter" $ do     it "extracts modules by filtering `value` declarations" $@@ -110,7 +92,7 @@         [moduleD, moduleG, moduleE, moduleH] `shouldBe` []     it "extracts module by filtering `type` declarations" $       runDeclaration [D.Type]-        [moduleA, moduleB, moduleC, moduleD, moduleE] `shouldBe` [moduleC]+        [moduleA, moduleB, moduleC, moduleD, moduleE] `shouldBe` [moduleC, moduleD]     it "removes everything if a `type` declaration have not been found" $       runDeclaration [D.Type]         [moduleA, moduleG, moduleE, moduleH] `shouldBe` []@@ -144,15 +126,9 @@     it "removes everything if a `typeoperator` declaration have not been found" $       runDeclaration [D.TypeOperator]         [moduleA, moduleD] `shouldBe` []-    it "extracts module by filtering `kind` declarations" $-      runDeclaration [D.Kind]-        [moduleA, moduleD, moduleG, moduleI, moduleF] `shouldBe` [moduleD]-    it "removes everything if a `kind` declaration have not been found" $-      runDeclaration [D.Kind]-        [moduleA, moduleC] `shouldBe` []     it "extracts modules by filtering `value` and `synonym` declarations" $       runDeclaration [D.Value, D.Synonym]         [moduleA, moduleB, moduleD, moduleE] `shouldBe` [moduleA, moduleB, moduleE]-    it "extracts modules by filtering `value`, `kind`, and `valueoperator` declarations" $-      runDeclaration [D.Value, D.Kind, D.ValueOperator]-        [moduleA, moduleB, moduleD, moduleG, moduleE, moduleH] `shouldBe` [moduleA, moduleB, moduleD, moduleH]+    it "extracts modules by filtering `value`, and `valueoperator` declarations" $+      runDeclaration [D.Value, D.ValueOperator]+        [moduleA, moduleB, moduleD, moduleG, moduleE, moduleH] `shouldBe` [moduleA, moduleB, moduleH]
tests/Language/PureScript/Ide/ImportsSpec.hs view
@@ -120,8 +120,6 @@           prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideDtor i t Nothing)) mn q is)         addTypeImport i mn q is =           prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideType i Nothing [])) mn q is)-        addKindImport i mn q is =-          prettyPrintImportSection (addExplicitImport' (_idaDeclaration (Test.ideKind i)) mn q is)         qualify s = Just (Test.mn s)     it "adds an implicit unqualified import to a file without any imports" $       shouldBe@@ -196,20 +194,6 @@         [ "import Prelude"         , ""         , "import Data.Array (head, tail) as Array"-        ]-    it "adds a kind to an explicit import list" $-      shouldBe-        (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") Nothing simpleFileImports)-        [ "import Prelude"-        , ""-        , "import Control.Monad.Eff (kind Effect)"-        ]-    it "adds a kind to an explicit qualified import list" $-      shouldBe-        (addKindImport "Effect" (P.moduleNameFromString "Control.Monad.Eff") (qualify "Eff") simpleFileImports)-        [ "import Prelude"-        , ""-        , "import Control.Monad.Eff (kind Effect) as Eff"         ]     it "adds an operator to an explicit import list" $       shouldBe
tests/Language/PureScript/Ide/ReexportsSpec.hs view
@@ -40,7 +40,6 @@   , ("resolves a synonym reexport"     , [(mn "A", P.TypeRef testSpan (P.ProperName "SynonymA") Nothing)], [synonymA `annExp` "A"])   , ("resolves a class reexport", [(mn "A", P.TypeClassRef testSpan (P.ProperName "ClassA"))], [classA `annExp` "A"])-  , ("resolves a kind reexport", [(mn "A", P.KindRef testSpan (P.ProperName "KindA"))], [kindA `annExp` "A"])   ]  failTestCases :: [(Text, Refs)]
tests/Language/PureScript/Ide/SourceFileSpec.hs view
@@ -21,7 +21,7 @@ ann1 = (span1, []) ann2 = (span2, []) -typeAnnotation1, value1, synonym1, class1, class2, data1, data2, valueFixity, typeFixity, foreign1, foreign2, foreign3, member1 :: P.Declaration+typeAnnotation1, value1, synonym1, class1, class2, data1, data2, valueFixity, typeFixity, foreign1, foreign2, member1 :: P.Declaration typeAnnotation1 = P.TypeDeclaration (P.TypeDeclarationData ann1 (P.Ident "value1") P.srcREmpty) value1 = P.ValueDecl ann1 (P.Ident "value1") P.Public [] [] synonym1 = P.TypeSynonymDeclaration ann1 (P.ProperName "Synonym1") [] P.srcREmpty@@ -43,7 +43,6 @@     (P.OpName "~>") foreign1 = P.ExternDeclaration ann1 (P.Ident "foreign1") P.srcREmpty foreign2 = P.ExternDataDeclaration ann1 (P.ProperName "Foreign2") P.kindType-foreign3 = P.ExternKindDeclaration ann1 (P.ProperName "Foreign3") member1 = P.TypeDeclaration (P.TypeDeclarationData ann2 (P.Ident "member1") P.srcREmpty)  spec :: Spec@@ -69,8 +68,6 @@       extractSpans foreign1 `shouldBe` [(IdeNamespaced IdeNSValue "foreign1", span1)]     it "extracts a span for a data foreign declaration" $       extractSpans foreign2 `shouldBe` [(IdeNamespaced IdeNSType "Foreign2", span1)]-    it "extracts a span for a foreign kind declaration" $-      extractSpans foreign3 `shouldBe` [(IdeNamespaced IdeNSKind "Foreign3", span1)]   describe "Type annotations" $ do     it "extracts a type annotation" $       extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.srcREmpty)]
tests/Language/PureScript/Ide/StateSpec.hs view
@@ -19,7 +19,7 @@ ctorOperator =   ideValueOp ":" (P.Qualified (Just (mn "Test")) (Right "Cons")) 2 Nothing -typeOperator :: Maybe P.SourceKind -> IdeDeclarationAnn+typeOperator :: Maybe P.SourceType -> IdeDeclarationAnn typeOperator =   ideTypeOp ":" (P.Qualified (Just (mn "Test")) "List") 2 Nothing @@ -58,6 +58,10 @@       (P.Qualified (Just (mn "ClassModule")) (P.ProperName "MyClass"))       -- , edInstanceName =       (P.Ident "myClassInstance")+      -- . edInstanceForAll =+      []+      -- , edInstanceKinds =+      mempty       -- , edInstanceTypes =       mempty       -- , edInstanceConstraints =
tests/Language/PureScript/Ide/Test.hs view
@@ -67,13 +67,13 @@ ideValue :: Text -> Maybe P.SourceType -> IdeDeclarationAnn ideValue i ty = ida (IdeDeclValue (IdeValue (P.Ident i) (fromMaybe P.tyString ty))) -ideType :: Text -> Maybe P.SourceKind -> [(P.ProperName 'P.ConstructorName, P.SourceType)] -> IdeDeclarationAnn+ideType :: Text -> Maybe P.SourceType -> [(P.ProperName 'P.ConstructorName, P.SourceType)] -> IdeDeclarationAnn ideType pn ki dtors = ida (IdeDeclType (IdeType (P.ProperName pn) (fromMaybe P.kindType ki) dtors)) -ideSynonym :: Text -> Maybe P.SourceType -> Maybe P.SourceKind -> IdeDeclarationAnn+ideSynonym :: Text -> Maybe P.SourceType -> Maybe P.SourceType -> IdeDeclarationAnn ideSynonym pn ty kind = ida (IdeDeclTypeSynonym (IdeTypeSynonym (P.ProperName pn) (fromMaybe P.tyString ty) (fromMaybe P.kindType kind))) -ideTypeClass :: Text -> P.SourceKind -> [IdeInstance] -> IdeDeclarationAnn+ideTypeClass :: Text -> P.SourceType -> [IdeInstance] -> IdeDeclarationAnn ideTypeClass pn kind instances = ida (IdeDeclTypeClass (IdeTypeClass (P.ProperName pn) kind instances))  ideDtor :: Text -> Text -> Maybe P.SourceType -> IdeDeclarationAnn@@ -89,7 +89,7 @@         (fromMaybe P.Infix assoc)         t)) -ideTypeOp :: Text -> P.Qualified Text -> Integer -> Maybe P.Associativity -> Maybe P.SourceKind -> IdeDeclarationAnn+ideTypeOp :: Text -> P.Qualified Text -> Integer -> Maybe P.Associativity -> Maybe P.SourceType -> IdeDeclarationAnn ideTypeOp opName ident precedence assoc k =   ida (IdeDeclTypeOperator        (IdeTypeOperator@@ -100,7 +100,7 @@         k))  ideKind :: Text -> IdeDeclarationAnn-ideKind pn = ida (IdeDeclKind (P.ProperName pn))+ideKind pn = ideType pn (Just P.kindType) []  ideModule :: Text -> IdeDeclarationAnn ideModule name = ida (IdeDeclModule (mn name))
tests/Main.hs view
@@ -10,7 +10,6 @@  import Test.Tasty -import qualified TestCst import qualified TestCompiler import qualified TestCoreFn import qualified TestDocs@@ -34,7 +33,6 @@   heading "Updating support code"   TestUtils.updateSupportCode -  cstTests <- TestCst.main   ideTests <- TestIde.main   compilerTests <- TestCompiler.main   makeTests <- TestMake.main@@ -50,8 +48,7 @@   defaultMain $     testGroup       "Tests"-      [ cstTests-      , compilerTests+      [ compilerTests       , makeTests       , psciTests       , pscBundleTests
tests/TestCompiler.hs view
@@ -20,6 +20,10 @@ --   -- @shouldFailWith TypesDoNotUnify --   -- @shouldFailWith TypesDoNotUnify --   -- @shouldFailWith TransitiveExportError+--+-- Failing tests also check their output against the relative golden files (`.out`).+-- The golden files are generated automatically when missing, and can be updated+-- by passing `--accept` to `--test-arguments.`  import Prelude () import Prelude.Compat@@ -31,9 +35,12 @@ import Data.List (sort, stripPrefix, intercalate, minimumBy) import Data.Maybe (mapMaybe) import qualified Data.Text as T+import qualified Data.Text.Encoding as T  import qualified Data.Map as M +import qualified Data.ByteString.Lazy as BS+ import Control.Monad  import System.Exit@@ -42,75 +49,86 @@ import System.IO import System.IO.UTF8 (readUTF8File) +import Text.Regex.Base+import Text.Regex.TDFA (Regex)+ import TestUtils import Test.Tasty import Test.Tasty.Hspec+import Test.Tasty (testGroup)+import Test.Tasty.Golden (goldenVsString)  main :: IO TestTree-main = testSpec "compiler" spec--spec :: Spec-spec = do-  (supportModules, supportExterns, supportForeigns) <- runIO $ setupSupportModules+main = do+  (supportModules, supportExterns, supportForeigns) <- setupSupportModules+  passing <- passingTests supportModules supportExterns supportForeigns+  warning <- warningTests supportModules supportExterns supportForeigns+  failing <- failingTests supportModules supportExterns supportForeigns+  return . testGroup "compiler" $ [passing, warning, failing] -  (passingTestCases, warningTestCases, failingTestCases) <- runIO $-    (,,) <$> getTestFiles "passing"-         <*> getTestFiles "warning"-         <*> getTestFiles "failing"+passingTests+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> IO TestTree+passingTests supportModules supportExterns supportForeigns = do+  passingTestCases <- getTestFiles "passing" -  outputFile <- runIO $ createOutputFile logfile+  outputFile <- createOutputFile logfile -  context "Passing examples" $+  testSpec "Passing examples" $     forM_ passingTestCases $ \testPurs ->       it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $         assertCompiles supportModules supportExterns supportForeigns testPurs outputFile -  context "Warning examples" $-    forM_ warningTestCases $ \testPurs -> do-      let mainPath = getTestMain testPurs-      expectedWarnings <- runIO $ getShouldWarnWith mainPath+warningTests+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> IO TestTree+warningTests supportModules supportExterns supportForeigns = do+  warningTestCases <- getTestFiles "warning"+  tests <- forM warningTestCases $ \testPurs -> do+    let mainPath = getTestMain testPurs+    expectedWarnings <- getShouldWarnWith mainPath+    wTc <- testSpecs $       it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $         assertCompilesWithWarnings supportModules supportExterns supportForeigns testPurs expectedWarnings+    return $ wTc ++ [ goldenVsString+                      ("'" <> takeFileName mainPath <> "' golden test")+                      (replaceExtension mainPath ".out")+                      (BS.fromStrict . T.encodeUtf8 . T.pack <$> printErrorOrWarning supportModules supportExterns supportForeigns testPurs)+                    ]+  return $ testGroup "Warning examples" $ concat tests -  context "Failing examples" $-    forM_ failingTestCases $ \testPurs -> do-      let mainPath = getTestMain testPurs-      expectedFailures <- runIO $ getShouldFailWith mainPath+failingTests+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> IO TestTree+failingTests supportModules supportExterns supportForeigns = do+  failingTestCases <- getTestFiles "failing"+  tests <- forM failingTestCases $ \testPurs -> do+    let mainPath = getTestMain testPurs+    expectedFailures <- getShouldFailWith mainPath+    fTc <- testSpecs $       it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $         assertDoesNotCompile supportModules supportExterns supportForeigns testPurs expectedFailures--  where--  -- Takes the test entry point from a group of purs files - this is determined-  -- by the file with the shortest path name, as everything but the main file-  -- will be under a subdirectory.-  getTestMain :: [FilePath] -> FilePath-  getTestMain = minimumBy (compare `on` length)--  -- Scans a file for @shouldFailWith directives in the comments, used to-  -- determine expected failures-  getShouldFailWith :: FilePath -> IO [String]-  getShouldFailWith = extractPragma "shouldFailWith"--  -- Scans a file for @shouldWarnWith directives in the comments, used to-  -- determine expected warnings-  getShouldWarnWith :: FilePath -> IO [String]-  getShouldWarnWith = extractPragma "shouldWarnWith"--  extractPragma :: String -> FilePath -> IO [String]-  extractPragma pragma = fmap go . readUTF8File-    where-      go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim-+    return $ fTc ++ [ goldenVsString+                    ("'" <> takeFileName mainPath <> "' golden test")+                    (replaceExtension mainPath ".out")+                    (BS.fromStrict . T.encodeUtf8 . T.pack <$> printErrorOrWarning supportModules supportExterns supportForeigns testPurs)+                  ]+  return $ testGroup "Failing examples" $ concat tests -checkShouldFailWith :: [String] -> P.MultipleErrors -> Maybe String-checkShouldFailWith expected errs =+checkShouldReport :: [String] -> (P.MultipleErrors -> String) -> P.MultipleErrors -> Maybe String+checkShouldReport expected prettyPrintDiagnostics errs =   let actual = map P.errorCode $ P.runMultipleErrors errs   in if sort expected == sort (map T.unpack actual)     then checkPositioned errs-    else Just $ "Expected these errors: " ++ show expected ++ ", but got these: "-      ++ show actual ++ ", full error messages: \n"-      ++ unlines (map (P.renderBox . P.prettyPrintSingleError P.defaultPPEOptions) (P.runMultipleErrors errs))+    else Just $ "Expected these diagnostics: " ++ show expected ++ ", but got these: "+      ++ show actual ++ ", full diagnostic messages: \n"+      ++ prettyPrintDiagnostics errs  checkPositioned :: P.MultipleErrors -> Maybe String checkPositioned errs =@@ -119,7 +137,7 @@       Nothing     errs' ->       Just-        $ "Found errors with missing source spans:\n"+        $ "Found diagnostics with missing source spans:\n"         ++ unlines (map (P.renderBox . P.prettyPrintSingleError P.defaultPPEOptions) errs')   where   guardSpans :: P.ErrorMessage -> Maybe P.ErrorMessage@@ -174,13 +192,7 @@       Left errs ->         return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs       Right warnings ->-        return-          . fmap (printAllWarnings warnings)-          $ checkShouldFailWith shouldWarnWith warnings--  where-  printAllWarnings warnings =-    (<> "\n\n" <> P.prettyPrintMultipleErrors P.defaultPPEOptions warnings)+        return $ checkShouldReport shouldWarnWith (P.prettyPrintMultipleWarnings P.defaultPPEOptions) warnings  assertDoesNotCompile   :: [P.Module]@@ -197,12 +209,71 @@           then Just $ "shouldFailWith declaration is missing (errors were: "                       ++ show (map P.errorCode (P.runMultipleErrors errs))                       ++ ")"-          else checkShouldFailWith shouldFailWith errs+          else checkShouldReport shouldFailWith (P.prettyPrintMultipleErrors P.defaultPPEOptions) errs       Right _ ->         return $ Just "Should not have compiled"    where   noPreCheck = const (return ())++printErrorOrWarning+  :: [P.Module]+  -> [P.ExternsFile]+  -> M.Map P.ModuleName FilePath+  -> [FilePath]+  -> IO String+printErrorOrWarning supportModules supportExterns supportForeigns inputFiles = do+  -- Sorting the input files makes some messages (e.g., duplicate module) deterministic+  (res, warnings) <- compile supportModules supportExterns supportForeigns (sort inputFiles) noPreCheck+  return . normalizePaths $ case res of+    Left errs ->+      P.prettyPrintMultipleErrors P.defaultPPEOptions errs+    Right _ ->+      P.prettyPrintMultipleWarnings P.defaultPPEOptions warnings+  where+    noPreCheck = const (return ())++-- Replaces Windows-style paths in an error or warning with POSIX paths+normalizePaths :: String -> String+normalizePaths = if pathSeparator == '\\'+  then replaceMatches " [0-9A-Za-z_-]+(\\\\[0-9A-Za-z_-]+)+\\.[A-Za-z]+\\>" (map turnSlash)+  else id+  where+    turnSlash '\\' = '/'+    turnSlash c = c++-- Uses a function to replace all matches of a regular expression in a string+replaceMatches :: String -> (String -> String) -> String -> String+replaceMatches reString phi = go+  where+    re :: Regex+    re = makeRegex reString+    go :: String -> String+    go haystack =+      let (prefix, needle, suffix) = match re haystack+      in prefix ++ (if null needle then "" else phi needle ++ go suffix)++-- Takes the test entry point from a group of purs files - this is determined+-- by the file with the shortest path name, as everything but the main file+-- will be under a subdirectory.+getTestMain :: [FilePath] -> FilePath+getTestMain = minimumBy (compare `on` length)++-- Scans a file for @shouldFailWith directives in the comments, used to+-- determine expected failures+getShouldFailWith :: FilePath -> IO [String]+getShouldFailWith = extractPragma "shouldFailWith"++-- Scans a file for @shouldWarnWith directives in the comments, used to+-- determine expected warnings+getShouldWarnWith :: FilePath -> IO [String]+getShouldWarnWith = extractPragma "shouldWarnWith"++extractPragma :: String -> FilePath -> IO [String]+extractPragma pragma = fmap go . readUTF8File+  where+    go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim+  logfile :: FilePath logfile = "psc-tests.out"
tests/TestCoreFn.hs view
@@ -10,6 +10,7 @@  import Data.Aeson import Data.Aeson.Types as Aeson+import Data.Map as M import Data.Version  import Language.PureScript.AST.Literals@@ -49,7 +50,7 @@    specify "should parse version" $ do     let v = Version [0, 13, 6] []-        m = Module ss [] mn mp [] [] [] []+        m = Module ss [] mn mp [] [] M.empty [] []         r = fst <$> parseModule (moduleToJSON v m)     r `shouldSatisfy` isSuccess     case r of@@ -57,42 +58,50 @@       Aeson.Success v' -> v' `shouldBe` v    specify "should parse an empty module" $ do-    let r = parseMod $ Module ss [] mn mp [] [] [] []+    let r = parseMod $ Module ss [] mn mp [] [] M.empty [] []     r `shouldSatisfy` isSuccess     case r of       Error _   -> return ()       Aeson.Success m -> moduleName m `shouldBe` mn    specify "should parse source span" $ do-    let r = parseMod $ Module ss [] mn mp [] [] [] []+    let r = parseMod $ Module ss [] mn mp [] [] M.empty [] []     r `shouldSatisfy` isSuccess     case r of       Error _   -> return ()       Aeson.Success m -> moduleSourceSpan m `shouldBe` ss    specify "should parse module path" $ do-    let r = parseMod $ Module ss [] mn mp [] [] [] []+    let r = parseMod $ Module ss [] mn mp [] [] M.empty [] []     r `shouldSatisfy` isSuccess     case r of       Error _   -> return ()       Aeson.Success m -> modulePath m `shouldBe` mp    specify "should parse imports" $ do-    let r = parseMod $ Module ss [] mn mp [(ann, mn)] [] [] []+    let r = parseMod $ Module ss [] mn mp [(ann, mn)] [] M.empty [] []     r `shouldSatisfy` isSuccess     case r of       Error _   -> return ()       Aeson.Success m -> moduleImports m `shouldBe` [(ann, mn)]    specify "should parse exports" $ do-    let r = parseMod $ Module ss [] mn mp [] [Ident "exp"] [] []+    let r = parseMod $ Module ss [] mn mp [] [Ident "exp"] M.empty [] []     r `shouldSatisfy` isSuccess     case r of       Error _   -> return ()       Aeson.Success m -> moduleExports m `shouldBe` [Ident "exp"] +  specify "should parse re-exports" $ do+    let r = parseMod $ Module ss [] mn mp [] [] (M.singleton (ModuleName "Example.A") [Ident "exp"]) [] []+    r `shouldSatisfy` isSuccess+    case r of+      Error _   -> return ()+      Aeson.Success m -> moduleReExports m `shouldBe` M.singleton (ModuleName "Example.A") [Ident "exp"]++   specify "should parse foreign" $ do-    let r = parseMod $ Module ss [] mn mp [] [] [Ident "exp"] []+    let r = parseMod $ Module ss [] mn mp [] [] M.empty [Ident "exp"] []     r `shouldSatisfy` isSuccess     case r of       Error _   -> return ()@@ -100,7 +109,7 @@    context "Expr" $ do     specify "should parse literals" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "x1") $ Literal ann (NumericLiteral (Left 1))                 , NonRec ann (Ident "x2") $ Literal ann (NumericLiteral (Right 1.0))                 , NonRec ann (Ident "x3") $ Literal ann (StringLiteral (mkString "abc"))@@ -112,18 +121,18 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse Constructor" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "constructor") $ Constructor ann (ProperName "Either") (ProperName "Left") [Ident "value0"] ]       parseMod m `shouldSatisfy` isSuccess      specify "should parse Accessor" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "x") $                     Accessor ann (mkString "field") (Literal ann $ ObjectLiteral [(mkString "field", Literal ann (NumericLiteral (Left 1)))]) ]       parseMod m `shouldSatisfy` isSuccess      specify "should parse ObjectUpdate" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "objectUpdate") $                     ObjectUpdate ann                       (Literal ann $ ObjectLiteral [(mkString "field", Literal ann (StringLiteral (mkString "abc")))])@@ -132,14 +141,14 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse Abs" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "abs")                     $ Abs ann (Ident "x") (Var ann (Qualified (Just mn) (Ident "x")))                 ]       parseMod m `shouldSatisfy` isSuccess      specify "should parse App" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "app")                     $ App ann                         (Abs ann (Ident "x") (Var ann (Qualified Nothing (Ident "x"))))@@ -148,7 +157,7 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse Case" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "case") $                     Case ann [Var ann (Qualified Nothing (Ident "x"))]                       [ CaseAlternative@@ -159,7 +168,7 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse Case with guards" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "case") $                     Case ann [Var ann (Qualified Nothing (Ident "x"))]                       [ CaseAlternative@@ -170,7 +179,7 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse Let" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "case") $                     Let ann                       [ Rec [((ann, Ident "a"), Var ann (Qualified Nothing (Ident "x")))] ]@@ -180,28 +189,28 @@    context "Meta" $ do     specify "should parse IsConstructor" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec (ss, [], Nothing, Just (IsConstructor ProductType [Ident "x"])) (Ident "x") $                   Literal (ss, [], Nothing, Just (IsConstructor SumType [])) (CharLiteral 'a')                 ]       parseMod m `shouldSatisfy` isSuccess      specify "should parse IsNewtype" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec (ss, [], Nothing, Just IsNewtype) (Ident "x") $                   Literal ann (CharLiteral 'a')                 ]       parseMod m `shouldSatisfy` isSuccess      specify "should parse IsTypeClassConstructor" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec (ss, [], Nothing, Just IsTypeClassConstructor) (Ident "x") $                   Literal ann (CharLiteral 'a')                 ]       parseMod m `shouldSatisfy` isSuccess      specify "should parse IsForeign" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec (ss, [], Nothing, Just IsForeign) (Ident "x") $                   Literal ann (CharLiteral 'a')                 ]@@ -209,7 +218,7 @@    context "Binders" $ do     specify "should parse LiteralBinder" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "case") $                     Case ann [Var ann (Qualified Nothing (Ident "x"))]                       [ CaseAlternative@@ -220,7 +229,7 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse VarBinder" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "case") $                     Case ann [Var ann (Qualified Nothing (Ident "x"))]                       [ CaseAlternative@@ -236,7 +245,7 @@       parseMod m `shouldSatisfy` isSuccess      specify "should parse NamedBinder" $ do-      let m = Module ss [] mn mp [] [] []+      let m = Module ss [] mn mp [] [] M.empty []                 [ NonRec ann (Ident "case") $                     Case ann [Var ann (Qualified Nothing (Ident "x"))]                       [ CaseAlternative@@ -248,9 +257,9 @@    context "Comments" $ do     specify "should parse LineComment" $ do-      let m = Module ss [ LineComment "line" ] mn mp [] [] [] []+      let m = Module ss [ LineComment "line" ] mn mp [] [] M.empty [] []       parseMod m `shouldSatisfy` isSuccess      specify "should parse BlockComment" $ do-      let m = Module ss [ BlockComment "block" ] mn mp [] [] [] []+      let m = Module ss [ BlockComment "block" ] mn mp [] [] M.empty [] []       parseMod m `shouldSatisfy` isSuccess
− tests/TestCst.hs 
@@ -1,226 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-module TestCst where--import Prelude--import Control.Monad (when)-import qualified Data.ByteString.Lazy as BS-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.Text.IO as Text-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Golden (goldenVsString, findByExtension)-import Test.Tasty.QuickCheck-import Text.Read (readMaybe)-import Language.PureScript.CST.Errors as CST-import Language.PureScript.CST.Lexer as CST-import Language.PureScript.CST.Print as CST-import Language.PureScript.CST.Types-import System.FilePath (takeBaseName, replaceExtension)--main :: IO TestTree-main = do-  lytTests <- layoutTests-  pure $ testGroup "cst"-    [ lytTests-    , litTests-    ]--layoutTests :: IO TestTree-layoutTests = do-  pursFiles <- findByExtension [".purs"] "./tests/purs/layout"-  return $ testGroup "Layout golden tests" $ do-    file <- pursFiles-    pure $ goldenVsString-      (takeBaseName file)-      (replaceExtension file ".out")-      (BS.fromStrict . Text.encodeUtf8 <$> runLexer file)-  where-  runLexer file = do-    src <- Text.readFile file-    case sequence $ CST.lex src of-      Left (_, err) ->-        pure $ Text.pack $ CST.prettyPrintError err-      Right toks -> do-        pure $ CST.printTokens toks--litTests :: TestTree-litTests = testGroup "Literals"-  [ testProperty "Integer" $-      checkTok checkReadNum (\case TokInt _ a -> Just a; _ -> Nothing) . unInt-  , testProperty "Hex" $-      checkTok checkReadNum (\case TokInt _ a -> Just a; _ -> Nothing) . unHex-  , testProperty "Number" $-      checkTok checkReadNum (\case TokNumber _ a -> Just a; _ -> Nothing) . unFloat-  , testProperty "Exponent" $-      checkTok checkReadNum (\case TokNumber _ a -> Just a; _ -> Nothing) . unExponent--  , testProperty "Integer (round trip)" $ roundTripTok . unInt-  , testProperty "Hex (round trip)" $ roundTripTok . unHex-  , testProperty "Number (round trip)" $ roundTripTok . unFloat-  , testProperty "Exponent (round trip)" $ roundTripTok . unExponent-  , testProperty "Char (round trip)" $ roundTripTok . unChar-  , testProperty "String (round trip)" $ roundTripTok . unString-  , testProperty "Raw String (round trip)" $ roundTripTok . unRawString-  ]--readTok' :: String -> Text -> Gen SourceToken-readTok' failMsg t = case CST.lex t of-  Right tok : _ ->-    pure tok-  Left (_, err) : _ ->-    fail $ failMsg <> ": " <> CST.prettyPrintError err-  [] ->-    fail "Empty token stream"--readTok :: Text -> Gen SourceToken-readTok = readTok' "Failed to parse"--checkTok-  :: (Text -> a -> Gen Bool)-  -> (Token -> Maybe a)-  -> Text-  -> Gen Bool-checkTok p f t = do-  SourceToken _ tok <- readTok t-  case f tok of-    Just a  -> p t a-    Nothing -> fail $ "Failed to lex correctly: " <> show tok--roundTripTok :: Text -> Gen Bool-roundTripTok t = do-  tok <- readTok t-  let t' = CST.printTokens [tok]-  tok' <- readTok' "Failed to re-parse" t'-  pure $ tok == tok'--checkReadNum :: (Eq a, Read a) => Text -> a -> Gen Bool-checkReadNum t a = do-  let-    chs = case Text.unpack $ Text.replace ".e" ".0e" $ Text.replace "_" "" t of-      chs' | last chs' == '.' -> chs' <> "0"-      chs' -> chs'-  case (== a) <$> readMaybe chs of-    Just a' -> pure a'-    Nothing -> fail "Failed to `read`"--newtype PSSourceInt = PSSourceInt { unInt :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceInt where-  arbitrary = resize 16 genInt--newtype PSSourceFloat = PSSourceFloat { unFloat :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceFloat where-  arbitrary = resize 16 genFloat--newtype PSSourceExponent = PSSourceExponent { unExponent :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceExponent where-  arbitrary = PSSourceExponent <$> do-    floatPart <- unFloat <$> resize 5 genFloat-    signPart <- fromMaybe "" <$> elements [ Just "+", Just "-", Nothing ]-    expPart <- unInt <$> resize 1 genInt-    pure $ floatPart <> "e" <> signPart <> expPart--newtype PSSourceHex = PSSourceHex { unHex :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceHex where-  arbitrary = resize 16 genHex--newtype PSSourceChar = PSSourceChar { unChar :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceChar where-  arbitrary = genChar--newtype PSSourceString = PSSourceString { unString :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceString where-  arbitrary = resize 256 genString--newtype PSSourceRawString = PSSourceRawString { unRawString :: Text }-  deriving (Show, Eq)--instance Arbitrary PSSourceRawString where-  arbitrary = resize 256 genRawString--genInt :: Gen PSSourceInt-genInt = PSSourceInt . Text.pack <$> do-  (:) <$> nonZeroChar-      <*> listOf numChar--genFloat :: Gen PSSourceFloat-genFloat = PSSourceFloat <$> do-  intPart <- unInt <$> genInt-  floatPart <- Text.pack <$> listOf1 numChar-  pure $ intPart <> "." <> floatPart--genHex :: Gen PSSourceHex-genHex = PSSourceHex <$> do-  nums <- listOf1 hexDigit-  pure $ "0x" <> Text.pack nums--genChar :: Gen PSSourceChar-genChar = PSSourceChar <$> do-  ch <- resize 0xFFFF arbitrarySizedNatural >>= (genStringChar '\'' . toEnum)-  pure $ "'" <> ch <> "'"--genString :: Gen PSSourceString-genString = PSSourceString <$> do-  chs <- listOf $ arbitraryUnicodeChar >>= genStringChar '"'-  pure $ "\"" <> Text.concat chs <> "\""--genStringChar :: Char -> Char -> Gen Text-genStringChar delimiter ch = frequency-  [ (1, genCharEscape)-  , (10, if ch `elem` [delimiter, '\n', '\r', '\\']-           then discard-           else pure $ Text.singleton ch-    )-  ]--genRawString :: Gen PSSourceRawString-genRawString = PSSourceRawString <$> do-  chs <- listOf $ arbitraryUnicodeChar-  let-    k1 acc qs cs = do-      let (cs', q) = span (/= '"') cs-      k2 (acc <> cs') qs q-    k2 acc qs [] = acc <> qs-    k2 acc qs cs = do-      let (q, cs') = span (== '"') cs-      k1 (acc <> take 2 q) (qs <> drop 2 q) cs'-    chs' = k1 [] [] chs-  when (all (== '"') chs') discard-  pure $ "\"\"\"" <> Text.pack chs' <> "\"\"\""--genCharEscape :: Gen Text-genCharEscape = oneof-  [ pure "\\t"-  , pure "\\r"-  , pure "\\n"-  , pure "\\\""-  , pure "\\'"-  , pure "\\\\"-  , do-      chs <- resize 4 $ listOf1 hexDigit-      pure $ "\\x" <> Text.pack chs-  ]--numChar :: Gen Char-numChar = elements "0123456789_"--nonZeroChar :: Gen Char-nonZeroChar = elements "123456789"--hexDigit :: Gen Char-hexDigit = elements $ ['a'..'f'] <> ['A'..'F'] <> ['0'..'9']
tests/TestDocs.hs view
@@ -191,7 +191,7 @@     " should be empty"   ShouldHaveClassMethodDocComment mn decl method excerpt ->     "the string " <> T.pack (show excerpt) <> " should appear in the" <>-    " doc-comment for class method " <> T.pack (show method) <> " for " <> showQual mn decl +    " doc-comment for class method " <> T.pack (show method) <> " for " <> showQual mn decl   ShouldNotHaveClassMethodDocComment mn decl method ->     "Doc-comments for class method " <> T.pack (show method) <> " for " <> showQual mn decl <>     " should be empty"@@ -608,7 +608,7 @@    , ("Clash",       [ ShouldBeDocumented (n "Clash1") "value" []-      , ShouldBeDocumented (n "Clash1") "Type" []+      , ShouldBeDocumented (n "Clash1") "Type'" []       , ShouldBeDocumented (n "Clash1") "TypeClass" ["typeClassMember"]       ])
tests/TestGraph.hs view
@@ -22,7 +22,7 @@   let baseDir = "tests/purs/graph/"   let sourcesDir = baseDir <> "src/"   it "should match the graph fixture" $ do-    let modulePaths = (sourcesDir <>) <$> ["Module.purs", "Module2.purs"]+    let modulePaths = (sourcesDir <>) <$> ["Module.purs", "Module2.purs", "Module3.purs"]     let graphFixtureName = "graph.json"      graphFixture <- readUTF8FileT (baseDir <> graphFixtureName)
tests/TestHierarchy.hs view
@@ -53,7 +53,7 @@                  (P.internalModuleSourceSpan "<B>", [])                  (P.ProperName "B")                  []-                 [P.srcConstraint (P.Qualified Nothing $ P.ProperName "A") [] Nothing]+                 [P.srcConstraint (P.Qualified Nothing $ P.ProperName "A") [] [] Nothing]                  []                  []               ]
tests/TestPrimDocs.hs view
@@ -6,7 +6,7 @@ import Control.Exception (evaluate) import Control.DeepSeq (force) import qualified Data.Map as Map-import qualified Data.Set as Set+import qualified Data.Text as Text import qualified Language.PureScript as P import qualified Language.PureScript.Docs as D @@ -26,15 +26,15 @@   it "all Prim modules are fully documented" $ do     let actualPrimNames =           -- note that prim type classes are listed in P.primTypes-          (map (P.runProperName . P.disqualify . fst) $ Map.toList+          (filter (not . Text.any (== '$')) . map (P.runProperName . P.disqualify . fst) $ Map.toList             ( P.primTypes <>               P.primBooleanTypes <>+              P.primCoerceTypes <>               P.primOrderingTypes <>               P.primRowTypes <>               P.primRowListTypes <>               P.primTypeErrorTypes <>-              P.primSymbolTypes )) ++-          (map (P.runProperName . P.disqualify) $ Set.toList P.allPrimKinds)+              P.primSymbolTypes ))     let documentedPrimNames =           map D.declTitle (concatMap D.modDeclarations D.primModules)
tests/TestPscPublish.hs view
@@ -44,11 +44,6 @@         "tests/purs/publish/basic-example"         "resolutions.json" -    it "basic example with legacy resolutions file" $ do-      testPackage-        "tests/purs/publish/basic-example"-        "resolutions-legacy.json"-   context "json compatibility" $ do     let compatDir = "tests" </> "json-compat"     versions <- runIO $ listDirectory compatDir
tests/TestPsci/CompletionTest.hs view
@@ -60,7 +60,7 @@    -- :kind should complete next word from types in scope   , (":kind Str", [":kind String"])-  , (":kind ST.", [":kind ST.ST"]) -- import Control.Monad.ST as ST+  , (":kind ST.", [":kind ST.Region", ":kind ST.ST"]) -- import Control.Monad.ST as ST   , (":kind STRef.", [":kind STRef.STRef"]) -- import Control.Monad.ST.Ref as STRef   , (":kind Effect.", [])
tests/TestUtils.hs view
@@ -15,6 +15,7 @@ import Control.Monad.Reader import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe+import Control.Monad.Writer.Class (tell) import Control.Exception import Data.Char (isSpace) import Data.Function (on)@@ -85,7 +86,7 @@   fileContents <- readInput pursFiles   modules <- runExceptT $ ExceptT . return $ CST.parseFromFiles id fileContents   case modules of-    Right ms -> return ms+    Right ms -> return (fmap (fmap snd) ms)     Left errs -> fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)  getSupportModuleNames :: IO [T.Text]@@ -121,7 +122,7 @@ getTestFiles :: FilePath -> IO [[FilePath]] getTestFiles testDir = do   cwd <- getCurrentDirectory-  let dir = cwd </> "tests" </> "purs" </> testDir+  let dir = "tests" </> "purs" </> testDir   testsInPath <- getFiles dir <$> testGlob dir   let rerunPath = dir </> "RerunCompilerTests.txt"   hasRerunFile <- doesFileExist rerunPath@@ -169,7 +170,9 @@   -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors) compile supportModules supportExterns supportForeigns inputFiles check = runTest $ do   fs <- liftIO $ readInput inputFiles-  ms <- CST.parseFromFiles id fs+  msWithWarnings <- CST.parseFromFiles id fs+  tell $ foldMap (\(fp, (ws, _)) -> CST.toMultipleWarnings fp ws) msWithWarnings+  let ms = fmap snd <$> msWithWarnings   foreigns <- inferForeignModules ms   liftIO (check (map snd ms))   let actions = makeActions supportModules (foreigns `M.union` supportForeigns)
tests/purs/docs/bower_components/purescript-newtype/src/Data/Newtype.purs view
@@ -1,5 +1,6 @@ module Data.Newtype where -class Newtype t a | t -> a where-  wrap :: a -> t-  unwrap :: t -> a+import Prim.Coerce (class Coercible)++class Newtype :: Type -> Type -> Constraint+class Coercible t a <= Newtype t a | t -> a
tests/purs/docs/output/Ado/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Ado","comments":null,"declarations":[{"children":[],"comments":null,"title":"test","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[4,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Ado.purs","end":[9,16]}}]}+{"reExports":[],"name":"Ado","comments":null,"declarations":[{"children":[],"comments":null,"title":"test","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[4,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Ado.purs","end":[9,16]}}]}
tests/purs/docs/output/ChildDeclOrder/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"ChildDeclOrder","comments":null,"declarations":[{"children":[{"comments":null,"title":"First","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"Second","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"showTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Show"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[18,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[19,15]}},{"comments":null,"title":"fooTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Foo"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[21,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[23,16]}}],"comments":null,"title":"Two","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[9,11]}},{"children":[{"comments":null,"title":"show","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}},"sourceSpan":{"start":[12,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[12,22]}},{"comments":null,"title":"showTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Show"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[18,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[19,15]}}],"comments":null,"title":"Show","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[11,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[12,22]}},{"children":[{"comments":null,"title":"foo1","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[15,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[15,12]}},{"comments":null,"title":"foo2","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[16,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[16,12]}},{"comments":null,"title":"fooTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Foo"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[21,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[23,16]}},{"comments":null,"title":"fooInt","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Foo"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}},"sourceSpan":{"start":[25,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[27,11]}}],"comments":null,"title":"Foo","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[14,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[16,12]}}]}+{"reExports":[],"name":"ChildDeclOrder","comments":null,"declarations":[{"children":[{"comments":null,"title":"First","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"Second","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"showTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Show"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[18,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[19,15]}},{"comments":null,"title":"fooTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Foo"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[21,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[23,16]}}],"comments":null,"title":"Two","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[9,11]}},{"children":[{"comments":null,"title":"show","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}},"sourceSpan":{"start":[12,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[12,22]}},{"comments":null,"title":"showTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Show"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[18,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[19,15]}}],"comments":null,"title":"Show","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[11,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[12,22]}},{"children":[{"comments":null,"title":"foo1","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[15,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[15,12]}},{"comments":null,"title":"foo2","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[16,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[16,12]}},{"comments":null,"title":"fooTwo","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Foo"]},{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Two"]}]}},"sourceSpan":{"start":[21,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[23,16]}},{"comments":null,"title":"fooInt","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["ChildDeclOrder"],"Foo"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}},"sourceSpan":{"start":[25,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[27,11]}}],"comments":null,"title":"Foo","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[14,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ChildDeclOrder.purs","end":[16,12]}}]}
tests/purs/docs/output/Clash1a/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Clash1a","comments":null,"declarations":[{"children":[],"comments":null,"title":"value","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash1a.purs","end":[3,13]}},{"children":[],"comments":null,"title":"Type","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash1a.purs","end":[6,16]}},{"children":[{"comments":null,"title":"typeClassMember","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[9,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash1a.purs","end":[9,23]}}],"comments":null,"title":"TypeClass","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash1a.purs","end":[9,23]}}]}+{"reExports":[],"name":"Clash1a","comments":null,"declarations":[{"children":[],"comments":null,"title":"value","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash1a.purs","end":[3,13]}},{"children":[],"comments":null,"title":"Type'","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash1a.purs","end":[6,17]}},{"children":[{"comments":null,"title":"typeClassMember","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[9,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash1a.purs","end":[9,23]}}],"comments":null,"title":"TypeClass","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash1a.purs","end":[9,23]}}]}
tests/purs/docs/output/Clash2a/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Clash2a","comments":null,"declarations":[{"children":[],"comments":null,"title":"value","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash2a.purs","end":[3,16]}},{"children":[],"comments":null,"title":"Type","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash2a.purs","end":[6,19]}},{"children":[{"comments":null,"title":"typeClassMember","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},"sourceSpan":{"start":[9,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash2a.purs","end":[9,28]}}],"comments":null,"title":"TypeClass","info":{"fundeps":[],"arguments":[["a",null],["b",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Clash2a.purs","end":[9,28]}}]}+{"reExports":[],"name":"Clash2a","comments":null,"declarations":[{"children":[],"comments":null,"title":"value","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash2a.purs","end":[3,16]}},{"children":[],"comments":null,"title":"Type'","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash2a.purs","end":[6,20]}},{"children":[{"comments":null,"title":"typeClassMember","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},"sourceSpan":{"start":[9,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash2a.purs","end":[9,28]}}],"comments":null,"title":"TypeClass","info":{"fundeps":[],"arguments":[["a",null],["b",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Clash2a.purs","end":[9,28]}}]}
tests/purs/docs/output/ConstrainedArgument/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"ConstrainedArgument","comments":null,"declarations":[{"children":[],"comments":null,"title":"Foo","info":{"fundeps":[],"arguments":[["t",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[3,12]}},{"children":[],"comments":null,"title":"WithoutArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Prim"],"Partial"],"constraintArgs":[],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}},"sourceSpan":{"start":[5,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[5,54]}},{"children":[],"comments":null,"title":"WithArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["ConstrainedArgument"],"Foo"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[6,52]}},{"children":[],"comments":null,"title":"MultiWithoutArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Prim"],"Partial"],"constraintArgs":[],"constraintData":null},{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Prim"],"Partial"],"constraintArgs":[],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[7,65]}},{"children":[],"comments":null,"title":"MultiWithArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["ConstrainedArgument"],"Foo"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintData":null},{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["ConstrainedArgument"],"Foo"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"b"}],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]},null]}},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[8,63]}}]}+{"reExports":[],"name":"ConstrainedArgument","comments":null,"declarations":[{"children":[],"comments":null,"title":"Foo","info":{"fundeps":[],"arguments":[["t",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[3,22]}},{"children":[],"comments":null,"title":"WithoutArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Prim"],"Partial"],"constraintArgs":[],"constraintKindArgs":[],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}},"sourceSpan":{"start":[5,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[5,54]}},{"children":[],"comments":null,"title":"WithArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["ConstrainedArgument"],"Foo"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintKindArgs":[],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[6,52]}},{"children":[],"comments":null,"title":"MultiWithoutArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Prim"],"Partial"],"constraintArgs":[],"constraintKindArgs":[],"constraintData":null},{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Prim"],"Partial"],"constraintArgs":[],"constraintKindArgs":[],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[7,65]}},{"children":[],"comments":null,"title":"MultiWithArgs","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["ConstrainedArgument"],"Foo"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintKindArgs":[],"constraintData":null},{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["ConstrainedArgument"],"Foo"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"b"}],"constraintKindArgs":[],"constraintData":null},{"annotation":[],"tag":"TypeVar","contents":"a"}]}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]},null]}},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ConstrainedArgument.purs","end":[8,63]}}]}
tests/purs/docs/output/Data.Newtype/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Data.Newtype","comments":null,"declarations":[{"children":[{"comments":null,"title":"wrap","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"t"}]}},"sourceSpan":{"start":[4,3],"name":"bower_components/purescript-newtype/src/Data/Newtype.purs","end":[4,17]}},{"comments":null,"title":"unwrap","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"t"}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]}},"sourceSpan":{"start":[5,3],"name":"bower_components/purescript-newtype/src/Data/Newtype.purs","end":[5,19]}}],"comments":null,"title":"Newtype","info":{"fundeps":[[["t"],["a"]]],"arguments":[["t",null],["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[3,1],"name":"bower_components/purescript-newtype/src/Data/Newtype.purs","end":[5,19]}}]}+{"reExports":[],"name":"Data.Newtype","comments":null,"declarations":[{"children":[],"comments":null,"title":"Newtype","info":{"fundeps":[[["t"],["a"]]],"arguments":[["t",null],["a",null]],"declType":"typeClass","superclasses":[{"constraintAnn":[],"constraintClass":[["Prim","Coerce"],"Coercible"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"t"},{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintKindArgs":[],"constraintData":null}]},"sourceSpan":{"start":[6,1],"name":"bower_components/purescript-newtype/src/Data/Newtype.purs","end":[6,44]}}]}
tests/purs/docs/output/DeclOrder/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"DeclOrder","comments":null,"declarations":[{"children":[],"comments":null,"title":"A","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[16,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrder.purs","end":[16,8]}},{"children":[],"comments":null,"title":"x1","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[10,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrder.purs","end":[10,7]}},{"children":[],"comments":null,"title":"X2","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[13,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrder.purs","end":[13,8]}},{"children":[],"comments":null,"title":"x3","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[11,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrder.purs","end":[11,7]}},{"children":[],"comments":null,"title":"X4","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[14,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrder.purs","end":[14,8]}},{"children":[],"comments":null,"title":"B","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[17,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrder.purs","end":[17,8]}}]}+{"reExports":[],"name":"DeclOrder","comments":null,"declarations":[{"children":[],"comments":null,"title":"A","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[16,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrder.purs","end":[16,8]}},{"children":[],"comments":null,"title":"x1","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[10,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrder.purs","end":[10,7]}},{"children":[],"comments":null,"title":"X2","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[13,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrder.purs","end":[13,8]}},{"children":[],"comments":null,"title":"x3","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[11,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrder.purs","end":[11,7]}},{"children":[],"comments":null,"title":"X4","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[14,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrder.purs","end":[14,8]}},{"children":[],"comments":null,"title":"B","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[17,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrder.purs","end":[17,8]}}]}
tests/purs/docs/output/DeclOrderNoExportList/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"DeclOrderNoExportList","comments":null,"declarations":[{"children":[],"comments":null,"title":"x1","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[3,7]}},{"children":[],"comments":null,"title":"x3","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[4,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[4,7]}},{"children":[],"comments":null,"title":"X2","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[6,8]}},{"children":[],"comments":null,"title":"X4","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[7,8]}},{"children":[],"comments":null,"title":"A","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[9,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[9,8]}},{"children":[],"comments":null,"title":"B","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[10,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[10,8]}}]}+{"reExports":[],"name":"DeclOrderNoExportList","comments":null,"declarations":[{"children":[],"comments":null,"title":"x1","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[3,7]}},{"children":[],"comments":null,"title":"x3","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[4,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[4,7]}},{"children":[],"comments":null,"title":"X2","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[6,8]}},{"children":[],"comments":null,"title":"X4","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[7,8]}},{"children":[],"comments":null,"title":"A","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[9,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[9,8]}},{"children":[],"comments":null,"title":"B","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[10,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DeclOrderNoExportList.purs","end":[10,8]}}]}
tests/purs/docs/output/Desugar/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Desugar","comments":null,"declarations":[{"children":[{"comments":null,"title":"X","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"X","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Desugar.purs","end":[3,19]}},{"children":[],"comments":null,"title":"test","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Desugar"],"X"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]},null]},null]}},"sourceSpan":{"start":[5,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Desugar.purs","end":[5,38]}}]}+{"reExports":[],"name":"Desugar","comments":null,"declarations":[{"children":[{"comments":null,"title":"X","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"X","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Desugar.purs","end":[3,19]}},{"children":[],"comments":null,"title":"test","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Desugar"],"X"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]},null]},null]}},"sourceSpan":{"start":[5,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Desugar.purs","end":[5,38]}}]}
tests/purs/docs/output/DocComments/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"DocComments","comments":null,"declarations":[{"children":[],"comments":"This declaration has a code block:\n\n    example == 0\n\nHere we are really testing that the leading whitespace is not stripped, as\nthis ensures that we don't accidentally change code blocks into normal\nparagraphs.\n","title":"example","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[10,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocComments.purs","end":[10,15]}}]}+{"reExports":[],"name":"DocComments","comments":null,"declarations":[{"children":[],"comments":"This declaration has a code block:\n\n    example == 0\n\nHere we are really testing that the leading whitespace is not stripped, as\nthis ensures that we don't accidentally change code blocks into normal\nparagraphs.\n","title":"example","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[10,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocComments.purs","end":[10,15]}}]}
tests/purs/docs/output/DocCommentsClassMethod/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"DocCommentsClassMethod","comments":null,"declarations":[{"children":[{"comments":"class method comment\n","title":"bar","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[5,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocCommentsClassMethod.purs","end":[5,11]}},{"comments":null,"title":"baz","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]}},"sourceSpan":{"start":[6,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocCommentsClassMethod.purs","end":[6,21]}}],"comments":null,"title":"Foo","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocCommentsClassMethod.purs","end":[6,21]}}]}+{"reExports":[],"name":"DocCommentsClassMethod","comments":null,"declarations":[{"children":[{"comments":"class method comment\n","title":"bar","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[5,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocCommentsClassMethod.purs","end":[5,11]}},{"comments":null,"title":"baz","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]}},"sourceSpan":{"start":[6,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocCommentsClassMethod.purs","end":[6,21]}}],"comments":null,"title":"Foo","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocCommentsClassMethod.purs","end":[6,21]}}]}
tests/purs/docs/output/DocCommentsDataConstructor/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"DocCommentsDataConstructor","comments":null,"declarations":[{"children":[{"comments":"data constructor comment\n","title":"Bar","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"Baz","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"Foo","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocCommentsDataConstructor.purs","end":[6,8]}},{"children":[{"comments":null,"title":"ComplexBar","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":"another data constructor comment\n","title":"ComplexBaz","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"ComplexFoo","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocCommentsDataConstructor.purs","end":[11,19]}},{"children":[{"comments":"newtype data constructor comment\n","title":"NewtypeFoo","info":{"arguments":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Record"]},{"annotation":[],"tag":"RCons","contents":["newtypeBar",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]},{"annotation":[],"tag":"REmpty"}]}]}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"NewtypeFoo","info":{"declType":"data","dataDeclType":"newtype","typeArguments":[]},"sourceSpan":{"start":[13,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DocCommentsDataConstructor.purs","end":[15,40]}}]}+{"reExports":[],"name":"DocCommentsDataConstructor","comments":null,"declarations":[{"children":[{"comments":"data constructor comment\n","title":"Bar","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"Baz","info":{"arguments":[],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"Foo","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocCommentsDataConstructor.purs","end":[6,8]}},{"children":[{"comments":null,"title":"ComplexBar","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":"another data constructor comment\n","title":"ComplexBaz","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"ComplexFoo","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocCommentsDataConstructor.purs","end":[11,19]}},{"children":[{"comments":"newtype data constructor comment\n","title":"NewtypeFoo","info":{"arguments":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Record"]},{"annotation":[],"tag":"RCons","contents":["newtypeBar",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]},{"annotation":[],"tag":"REmpty"}]}]}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"NewtypeFoo","info":{"declType":"data","dataDeclType":"newtype","typeArguments":[]},"sourceSpan":{"start":[13,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DocCommentsDataConstructor.purs","end":[15,40]}}]}
tests/purs/docs/output/DuplicateNames/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"DuplicateNames","comments":null,"declarations":[{"children":[],"comments":null,"title":"unit","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/DuplicateNames.purs","end":[8,12]}}]}+{"reExports":[],"name":"DuplicateNames","comments":null,"declarations":[{"children":[],"comments":null,"title":"unit","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/DuplicateNames.purs","end":[8,12]}}]}
tests/purs/docs/output/Example2/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Example2","comments":null,"declarations":[{"children":[],"comments":null,"title":"one","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Example2.purs","end":[3,11]}},{"children":[],"comments":null,"title":"two","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Example2.purs","end":[6,11]}}]}+{"reExports":[],"name":"Example2","comments":null,"declarations":[{"children":[],"comments":null,"title":"one","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Example2.purs","end":[3,11]}},{"children":[],"comments":null,"title":"two","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Example2.purs","end":[6,11]}}]}
tests/purs/docs/output/ExplicitExport/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"ExplicitExport","comments":null,"declarations":[{"children":[],"comments":null,"title":"one","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ExplicitExport.purs","end":[3,11]}}]}+{"reExports":[],"name":"ExplicitExport","comments":null,"declarations":[{"children":[],"comments":null,"title":"one","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ExplicitExport.purs","end":[3,11]}}]}
tests/purs/docs/output/ExplicitTypeSignatures/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"ExplicitTypeSignatures","comments":null,"declarations":[{"children":[],"comments":null,"title":"explicit","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["something",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"something"}]},{"annotation":[],"tag":"TypeVar","contents":"something"}]},null]}},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ExplicitTypeSignatures.purs","end":[6,53]}},{"children":[],"comments":null,"title":"anInt","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[12,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ExplicitTypeSignatures.purs","end":[12,11]}},{"children":[],"comments":null,"title":"aNumber","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Number"]}},"sourceSpan":{"start":[16,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ExplicitTypeSignatures.purs","end":[16,14]}}]}+{"reExports":[],"name":"ExplicitTypeSignatures","comments":null,"declarations":[{"children":[],"comments":null,"title":"explicit","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["something",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"something"}]},{"annotation":[],"tag":"TypeVar","contents":"something"}]},null]}},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ExplicitTypeSignatures.purs","end":[6,53]}},{"children":[],"comments":null,"title":"anInt","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[12,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ExplicitTypeSignatures.purs","end":[12,11]}},{"children":[],"comments":null,"title":"aNumber","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Number"]}},"sourceSpan":{"start":[16,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ExplicitTypeSignatures.purs","end":[16,14]}}]}
tests/purs/docs/output/ImportedTwiceB/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"ImportedTwiceB","comments":null,"declarations":[{"children":[],"comments":null,"title":"foo","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/ImportedTwiceB.purs","end":[3,11]}}]}+{"reExports":[],"name":"ImportedTwiceB","comments":null,"declarations":[{"children":[],"comments":null,"title":"foo","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/ImportedTwiceB.purs","end":[3,11]}}]}
tests/purs/docs/output/MultiVirtual1/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"MultiVirtual1","comments":null,"declarations":[{"children":[],"comments":null,"title":"foo","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/MultiVirtual1.purs","end":[3,11]}}]}+{"reExports":[],"name":"MultiVirtual1","comments":null,"declarations":[{"children":[],"comments":null,"title":"foo","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/MultiVirtual1.purs","end":[3,11]}}]}
tests/purs/docs/output/MultiVirtual2/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"MultiVirtual2","comments":null,"declarations":[{"children":[],"comments":null,"title":"bar","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/MultiVirtual2.purs","end":[8,11]}}]}+{"reExports":[],"name":"MultiVirtual2","comments":null,"declarations":[{"children":[],"comments":null,"title":"bar","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/MultiVirtual2.purs","end":[8,11]}}]}
tests/purs/docs/output/MultiVirtual3/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"MultiVirtual3","comments":null,"declarations":[{"children":[],"comments":null,"title":"baz","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/MultiVirtual3.purs","end":[3,11]}}]}+{"reExports":[],"name":"MultiVirtual3","comments":null,"declarations":[{"children":[],"comments":null,"title":"baz","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/MultiVirtual3.purs","end":[3,11]}}]}
tests/purs/docs/output/NewOperators2/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"NewOperators2","comments":null,"declarations":[{"children":[],"comments":null,"title":"(>>>)","info":{"declType":"alias","alias":[["NewOperators2"],{"Right":{"Left":{"Ident":"_compose"}}}],"fixity":{"associativity":"infixl","precedence":8}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/NewOperators2.purs","end":[3,25]}},{"children":[],"comments":null,"title":"_compose","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"b"}]},{"annotation":[],"tag":"TypeVar","contents":"c"}]}}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}}]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"c"}]}}]}]},null]},null]},null]}},"sourceSpan":{"start":[5,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/NewOperators2.purs","end":[5,59]}}]}+{"reExports":[],"name":"NewOperators2","comments":null,"declarations":[{"children":[],"comments":null,"title":"(>>>)","info":{"declType":"alias","alias":[["NewOperators2"],{"Right":{"Left":{"Ident":"_compose"}}}],"fixity":{"associativity":"infixl","precedence":8}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/NewOperators2.purs","end":[3,25]}},{"children":[],"comments":null,"title":"_compose","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"b"}]},{"annotation":[],"tag":"TypeVar","contents":"c"}]}}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}}]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"c"}]}}]}]},null]},null]},null]}},"sourceSpan":{"start":[5,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/NewOperators2.purs","end":[5,59]}}]}
tests/purs/docs/output/Prim.Boolean/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.Boolean","comments":"The Prim.Boolean module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Boolean` data structure.","declarations":[{"children":[],"comments":"The `Boolean` kind provides True/False types at the type level\n","title":"Boolean","info":{"declType":"kind"},"sourceSpan":null},{"children":[],"comments":"The 'True' boolean type.\n","title":"True","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim","Boolean"],"Boolean"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'False' boolean type.\n","title":"False","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim","Boolean"],"Boolean"]},"declType":"externData"},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.Boolean","comments":"The Prim.Boolean module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Boolean` data structure.","declarations":[{"children":[],"comments":"The 'True' boolean type.\n","title":"True","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Boolean"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'False' boolean type.\n","title":"False","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Boolean"]},"declType":"externData"},"sourceSpan":null}]}
+ tests/purs/docs/output/Prim.Coerce/docs.json view
@@ -0,0 +1,1 @@+{"reExports":[],"name":"Prim.Coerce","comments":"The Prim.Coerce module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains an automatically solved type class for coercing types that have provably-identical runtime representations with [purescript-safe-coerce](https://pursuit.purescript.org/packages/purescript-safe-coerce).","declarations":[{"children":[],"comments":"Coercible is a two-parameter type class that has instances for types `a`\nand `b` if the compiler can infer that they have the same representation.\nCoercible constraints are solved according to the following rules:\n\n* _reflexivity_, any type has the same representation as itself:\n`Coercible a a` holds.\n\n* _symmetry_, if a type `a` can be coerced to some other type `b`, then `b`\ncan also be coerced back to `a`: `Coercible a b` implies `Coercible b a`.\n\n* _transitivity_, if a type `a` can be coerced to some other type `b` which\ncan be coerced to some other type `c`, then `a` can also be coerced to `c`:\n`Coercible a b` and `Coercible b c` imply `Coercible a c`.\n\n* Newtypes can be freely wrapped and unwrapped when their constructor is\nin scope:\n\n      newtype Age = Age Int\n\n`Coercible Int Age` and `Coercible Age Int` hold since `Age` has the same\nruntime representation than `Int`.\n\nNewtype constructors have to be in scope to preserve abstraction. It's\ncommon to declare a newtype to encode some invariants (non emptiness of\narrays with `Data.Array.NonEmpty.NonEmptyArray` for example), hide its\nconstructor and export smart constructors instead. Without this restriction,\nthe guarantees provided by such newtypes would be void.\n\n* If none of the above are applicable, two types of kind `Type` may be\ncoercible, but only if their heads are the same. For example,\n`Coercible (Maybe a) (Either a b)` does not hold because `Maybe` and\n`Either` are different. Those types don't share a common runtime\nrepresentation so coercing between them would be unsafe. In addition their\narguments may need to be identical or coercible, depending on the _roles_\nof the head's type parameters. Roles are documented in [the PureScript\nlanguage reference](https://github.com/purescript/documentation/blob/master/language/Roles.md).\n\nCoercible being polykinded, we can also coerce more than types of kind `Type`:\n\n* Rows are coercible when they have the same labels, when the corresponding\npairs of types are coercible and when their tails are coercible:\n`Coercible ( label :: a | r ) ( label :: b | s )` holds when\n`Coercible a b` and `Coercible r s` do. Closed rows cannot be coerced to\nopen rows.\n\n* Higher kinded types are coercible if they are coercible when fully\nsaturated: `Coercible (f :: _ -> Type) (g :: _ -> Type)` holds when\n`Coercible (f a) (g a)` does.\n\nThis rule may seem puzzling since there is no term of type `_ -> Type` to\napply `coerce` to, but it is necessary when coercing types with higher\nkinded parameters.\n","title":"Coercible","info":{"fundeps":[],"arguments":[["a",{"annotation":[],"tag":"TypeVar","contents":"k"}],["b",{"annotation":[],"tag":"TypeVar","contents":"k"}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}
tests/purs/docs/output/Prim.Ordering/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.Ordering","comments":"The Prim.Ordering module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Ordering` data structure.","declarations":[{"children":[],"comments":"The `Ordering` kind represents the three possibilites of comparing two\ntypes of the same kind: `LT` (less than), `EQ` (equal to), and\n`GT` (greater than).\n","title":"Ordering","info":{"declType":"kind"},"sourceSpan":null},{"children":[],"comments":"The 'less than' ordering type.\n","title":"LT","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim","Ordering"],"Ordering"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'equal to' ordering type.\n","title":"EQ","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim","Ordering"],"Ordering"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'greater than' ordering type.\n","title":"GT","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim","Ordering"],"Ordering"]},"declType":"externData"},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.Ordering","comments":"The Prim.Ordering module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Ordering` data structure.","declarations":[{"children":[],"comments":"The `Ordering` kind represents the three possibilities of comparing two\ntypes of the same kind: `LT` (less than), `EQ` (equal to), and\n`GT` (greater than).\n","title":"Ordering","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'less than' ordering type.\n","title":"LT","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'equal to' ordering type.\n","title":"EQ","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The 'greater than' ordering type.\n","title":"GT","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]},"declType":"externData"},"sourceSpan":null}]}
tests/purs/docs/output/Prim.Row/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.Row","comments":"The Prim.Row module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with row types.","declarations":[{"children":[],"comments":"The Union type class is used to compute the union of two rows of types\n(left-biased, including duplicates).\n\nThe third type argument represents the union of the first two.\n","title":"Union","info":{"fundeps":[[["left","right"],["union"]],[["right","union"],["left"]],[["union","left"],["right"]]],"arguments":[["left",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}],["right",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}],["union",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Nub type class is used to remove duplicate labels from rows.\n","title":"Nub","info":{"fundeps":[[["original"],["nubbed"]]],"arguments":[["original",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}],["nubbed",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Lacks type class asserts that a label does not occur in a given row.\n","title":"Lacks","info":{"fundeps":[],"arguments":[["label",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["row",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Cons type class is a 4-way relation which asserts that one row of\ntypes can be obtained from another by inserting a new label/type pair on\nthe left.\n","title":"Cons","info":{"fundeps":[[["label","a","tail"],["row"]],[["label","row"],["a","tail"]]],"arguments":[["label",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["a",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}],["tail",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}],["row",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.Row","comments":"The Prim.Row module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with row types.","declarations":[{"children":[],"comments":"The Union type class is used to compute the union of two rows of types\n(left-biased, including duplicates).\n\nThe third type argument represents the union of the first two.\n","title":"Union","info":{"fundeps":[[["left","right"],["union"]],[["right","union"],["left"]],[["union","left"],["right"]]],"arguments":[["left",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}],["right",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}],["union",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Nub type class is used to remove duplicate labels from rows.\n","title":"Nub","info":{"fundeps":[[["original"],["nubbed"]]],"arguments":[["original",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}],["nubbed",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Lacks type class asserts that a label does not occur in a given row.\n","title":"Lacks","info":{"fundeps":[],"arguments":[["label",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["row",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Cons type class is a 4-way relation which asserts that one row of\ntypes can be obtained from another by inserting a new label/type pair on\nthe left.\n","title":"Cons","info":{"fundeps":[[["label","a","tail"],["row"]],[["label","row"],["a","tail"]]],"arguments":[["label",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["a",{"annotation":[],"tag":"TypeVar","contents":"k"}],["tail",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}],["row",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}
tests/purs/docs/output/Prim.RowList/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.RowList","comments":"The Prim.RowList module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level list (`RowList`) that represents an ordered view of a row of types.","declarations":[{"children":[],"comments":"A type level list representation of a row of types.\n","title":"RowList","info":{"declType":"kind"},"sourceSpan":null},{"children":[],"comments":"Constructs a new `RowList` from a label, a type, and an existing tail\n`RowList`.  E.g: `Cons \"x\" Int (Cons \"y\" Int Nil)`.\n","title":"Cons","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]},{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim","RowList"],"RowList"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim","RowList"],"RowList"]}]}]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The empty `RowList`.\n","title":"Nil","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim","RowList"],"RowList"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"Compiler solved type class for generating a `RowList` from a closed row\nof types.  Entries are sorted by label and duplicates are preserved in\nthe order they appeared in the row.\n","title":"RowToList","info":{"fundeps":[[["row"],["list"]]],"arguments":[["row",{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}}],["list",{"annotation":[],"tag":"NamedKind","contents":[["Prim","RowList"],"RowList"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.RowList","comments":"The Prim.RowList module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level list (`RowList`) that represents an ordered view of a row of types.","declarations":[{"children":[],"comments":"A type level list representation of a row of types.\n","title":"RowList","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"Constructs a new `RowList` from a label, a type, and an existing tail\n`RowList`.  E.g: `Cons \"x\" Int (Cons \"y\" Int Nil)`.\n","title":"Cons","info":{"kind":{"annotation":[],"tag":"ForAll","contents":["k",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","RowList"],"RowList"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","RowList"],"RowList"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]}]}]},null]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The empty `RowList`.\n","title":"Nil","info":{"kind":{"annotation":[],"tag":"ForAll","contents":["k",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","RowList"],"RowList"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]},null]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"Compiler solved type class for generating a `RowList` from a closed row\nof types.  Entries are sorted by label and duplicates are preserved in\nthe order they appeared in the row.\n","title":"RowToList","info":{"fundeps":[[["row"],["list"]]],"arguments":[["row",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}],["list",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","RowList"],"RowList"]},{"annotation":[],"tag":"TypeVar","contents":"k"}]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}
tests/purs/docs/output/Prim.Symbol/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.Symbol","comments":"The Prim.Symbol module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with `Symbols`.","declarations":[{"children":[],"comments":"Compiler solved type class for appending `Symbol`s together.\n","title":"Append","info":{"fundeps":[[["left","right"],["appended"]],[["right","appended"],["left"]],[["appended","left"],["right"]]],"arguments":[["left",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["right",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["appended",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"Compiler solved type class for comparing two `Symbol`s.\nProduces an `Ordering`.\n","title":"Compare","info":{"fundeps":[[["left","right"],["ordering"]]],"arguments":[["left",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["right",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["ordering",{"annotation":[],"tag":"NamedKind","contents":[["Prim","Ordering"],"Ordering"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"Compiler solved type class for either splitting up a symbol into its\nhead and tail or for combining a head and tail into a new symbol.\nRequires the head to be a single character and the combined string\ncannot be empty.\n","title":"Cons","info":{"fundeps":[[["head","tail"],["symbol"]],[["symbol"],["head","tail"]]],"arguments":[["head",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["tail",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}],["symbol",{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.Symbol","comments":"The Prim.Symbol module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with `Symbols`.","declarations":[{"children":[],"comments":"Compiler solved type class for appending `Symbol`s together.\n","title":"Append","info":{"fundeps":[[["left","right"],["appended"]],[["right","appended"],["left"]],[["appended","left"],["right"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["appended",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"Compiler solved type class for comparing two `Symbol`s.\nProduces an `Ordering`.\n","title":"Compare","info":{"fundeps":[[["left","right"],["ordering"]]],"arguments":[["left",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["right",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["ordering",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"Compiler solved type class for either splitting up a symbol into its\nhead and tail or for combining a head and tail into a new symbol.\nRequires the head to be a single character and the combined string\ncannot be empty.\n","title":"Cons","info":{"fundeps":[[["head","tail"],["symbol"]],[["symbol"],["head","tail"]]],"arguments":[["head",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["tail",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}],["symbol",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null}]}
tests/purs/docs/output/Prim.TypeError/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim.TypeError","comments":"The Prim.TypeError module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains type classes that provide custom type error and warning functionality.","declarations":[{"children":[],"comments":"The Warn type class allows a custom compiler warning to be displayed.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Warn","info":{"fundeps":[],"arguments":[["message",{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Fail type class is part of the custom type errors feature. To provide\na custom type error when someone tries to use a particular instance,\nwrite that instance out with a Fail constraint.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Fail","info":{"fundeps":[],"arguments":[["message",{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"`Doc` is the kind of type-level documents.\n\nThis kind is used with the `Fail` and `Warn` type clases.\nBuild up a `Doc` with `Text`, `Quote`, `QuoteLabel`, `Beside`, and `Above`.\n","title":"Doc","info":{"declType":"kind"},"sourceSpan":null},{"children":[],"comments":"The Text type constructor makes a Doc from a Symbol\nto be used in a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Text","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Quote type constructor renders any concrete type as a Doc\nto be used in a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Quote","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The `QuoteLabel` type constructor will produce a `Doc` when given a `Symbol`. When the resulting `Doc` is rendered\nfor a `Warn` or `Fail` constraint, a syntactically valid label will be produced, escaping with quotes as needed.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"QuoteLabel","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Symbol"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Beside type constructor combines two Docs horizontally\nto be used in a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Beside","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]},{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Above type constructor combines two Docs vertically\nin a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Above","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]},{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim","TypeError"],"Doc"]}]}]},"declType":"externData"},"sourceSpan":null}]}+{"reExports":[],"name":"Prim.TypeError","comments":"The Prim.TypeError module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains type classes that provide custom type error and warning functionality.","declarations":[{"children":[],"comments":"The Warn type class allows a custom compiler warning to be displayed.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Warn","info":{"fundeps":[],"arguments":[["message",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"The Fail type class is part of the custom type errors feature. To provide\na custom type error when someone tries to use a particular instance,\nwrite that instance out with a Fail constraint.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Fail","info":{"fundeps":[],"arguments":[["message",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"`Doc` is the kind of type-level documents.\n\nThis kind is used with the `Fail` and `Warn` type classes.\nBuild up a `Doc` with `Text`, `Quote`, `QuoteLabel`, `Beside`, and `Above`.\n","title":"Doc","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Text type constructor makes a Doc from a Symbol\nto be used in a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Text","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Quote type constructor renders any concrete type as a Doc\nto be used in a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Quote","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The `QuoteLabel` type constructor will produce a `Doc` when given a `Symbol`. When the resulting `Doc` is rendered\nfor a `Warn` or `Fail` constraint, a syntactically valid label will be produced, escaping with quotes as needed.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"QuoteLabel","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Symbol"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Beside type constructor combines two Docs horizontally\nto be used in a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Beside","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Above type constructor combines two Docs vertically\nin a custom type error.\n\nFor more information, see\n[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md).\n","title":"Above","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Doc"]}]}]},"declType":"externData"},"sourceSpan":null}]}
tests/purs/docs/output/Prim/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Prim","comments":"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import.\n\n`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler. For example, row kinds (e.g. `# Type`, which is the kind of types such as `(name :: String, age :: Int)`), Type wildcards (e.g. `f :: _ -> Int`), and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md).\n","declarations":[{"children":[],"comments":"A function, which takes values of the type specified by the first type\nparameter, and returns values of the type specified by the second.\nIn the JavaScript backend, this is a standard JavaScript Function.\n\nThe type constructor `(->)` is syntactic sugar for this type constructor.\nIt is recommended to use `(->)` rather than `Function`, where possible.\n\nThat is, prefer this:\n\n    f :: Number -> Number\n\nto either of these:\n\n    f :: Function Number Number\n    f :: (->) Number Number\n","title":"Function","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"An Array: a data structure supporting efficient random access. In\nthe JavaScript backend, values of this type are represented as JavaScript\nArrays at runtime.\n\nConstruct values using literals:\n\n    x = [1,2,3,4,5] :: Array Int\n","title":"Array","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The type of records whose fields are known at compile time. In the\nJavaScript backend, values of this type are represented as JavaScript\nObjects at runtime.\n\nThe type signature here means that the `Record` type constructor takes\na row of concrete types. For example:\n\n    type Person = Record (name :: String, age :: Number)\n\nThe syntactic sugar with curly braces `{ }` is generally preferred, though:\n\n    type Person = { name :: String, age :: Number }\n\nThe row associates a type to each label which appears in the record.\n\n_Technical note_: PureScript allows duplicate labels in rows, and the\nmeaning of `Record r` is based on the _first_ occurrence of each label in\nthe row `r`.\n","title":"Record","info":{"kind":{"annotation":[],"tag":"FunKind","contents":[{"annotation":[],"tag":"Row","contents":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}},{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A double precision floating point number (IEEE 754).\n\nConstruct values of this type with literals:\n\n    y = 35.23 :: Number\n    z = 1.224e6 :: Number\n","title":"Number","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A 32-bit signed integer. See the purescript-integers package for details\nof how this is accomplished when compiling to JavaScript.\n\nConstruct values of this type with literals:\n\n    x = 23 :: Int\n","title":"Int","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A String. As in JavaScript, String values represent sequences of UTF-16\ncode units, which are not required to form a valid encoding of Unicode\ntext (for example, lone surrogates are permitted).\n\nConstruct values of this type with literals, using double quotes `\"`:\n\n    x = \"hello, world\" :: String\n\nMulti-line string literals are also supported with triple quotes (`\"\"\"`).\n","title":"String","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A single character (UTF-16 code unit). The JavaScript representation is a\nnormal String, which is guaranteed to contain one code unit. This means\nthat astral plane characters (i.e. those with code point values greater\nthan 0xFFFF) cannot be represented as Char values.\n\nConstruct values of this type with literals, using single quotes `'`:\n\n    x = 'a' :: Char\n","title":"Char","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A JavaScript Boolean value.\n\nConstruct values of this type with the literals `true` and `false`.\n","title":"Boolean","info":{"kind":{"annotation":[],"tag":"NamedKind","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Partial type class is used to indicate that a function is *partial,*\nthat is, it is not defined for all inputs. In practice, attempting to use\na partial function with a bad input will usually cause an error to be\nthrown, although it is not safe to assume that this will happen in all\ncases. For more information, see\n[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/).\n","title":"Partial","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"`Type` is the kind of all proper types: those that classify value-level terms.\nFor example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`.\n","title":"Type","info":{"declType":"kind"},"sourceSpan":null},{"children":[],"comments":"`Symbol` is the kind of type-level strings.\n\nConstruct types of this kind using the same literal syntax as documented\nfor strings.\n","title":"Symbol","info":{"declType":"kind"},"sourceSpan":null}]}+{"reExports":[],"name":"Prim","comments":"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import.\n\n`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md).\n","declarations":[{"children":[],"comments":"A function, which takes values of the type specified by the first type\nparameter, and returns values of the type specified by the second.\nIn the JavaScript backend, this is a standard JavaScript Function.\n\nThe type constructor `(->)` is syntactic sugar for this type constructor.\nIt is recommended to use `(->)` rather than `Function`, where possible.\n\nThat is, prefer this:\n\n    f :: Number -> Number\n\nto either of these:\n\n    f :: Function Number Number\n    f :: (->) Number Number\n","title":"Function","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"An Array: a data structure supporting efficient random access. In\nthe JavaScript backend, values of this type are represented as JavaScript\nArrays at runtime.\n\nConstruct values using literals:\n\n    x = [1,2,3,4,5] :: Array Int\n","title":"Array","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The type of records whose fields are known at compile time. In the\nJavaScript backend, values of this type are represented as JavaScript\nObjects at runtime.\n\nThe type signature here means that the `Record` type constructor takes\na row of concrete types. For example:\n\n    type Person = Record (name :: String, age :: Number)\n\nThe syntactic sugar with curly braces `{ }` is generally preferred, though:\n\n    type Person = { name :: String, age :: Number }\n\nThe row associates a type to each label which appears in the record.\n\n_Technical note_: PureScript allows duplicate labels in rows, and the\nmeaning of `Record r` is based on the _first_ occurrence of each label in\nthe row `r`.\n","title":"Record","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Row"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A double precision floating point number (IEEE 754).\n\nConstruct values of this type with literals:\n\n    y = 35.23 :: Number\n    z = 1.224e6 :: Number\n","title":"Number","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A 32-bit signed integer. See the purescript-integers package for details\nof how this is accomplished when compiling to JavaScript.\n\nConstruct values of this type with literals:\n\n    x = 23 :: Int\n","title":"Int","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A String. As in JavaScript, String values represent sequences of UTF-16\ncode units, which are not required to form a valid encoding of Unicode\ntext (for example, lone surrogates are permitted).\n\nConstruct values of this type with literals, using double quotes `\"`:\n\n    x = \"hello, world\" :: String\n\nMulti-line string literals are also supported with triple quotes (`\"\"\"`).\n","title":"String","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A single character (UTF-16 code unit). The JavaScript representation is a\nnormal String, which is guaranteed to contain one code unit. This means\nthat astral plane characters (i.e. those with code point values greater\nthan 0xFFFF) cannot be represented as Char values.\n\nConstruct values of this type with literals, using single quotes `'`:\n\n    x = 'a' :: Char\n","title":"Char","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"A JavaScript Boolean value.\n\nConstruct values of this type with the literals `true` and `false`.\n","title":"Boolean","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"The Partial type class is used to indicate that a function is *partial,*\nthat is, it is not defined for all inputs. In practice, attempting to use\na partial function with a bad input will usually cause an error to be\nthrown, although it is not safe to assume that this will happen in all\ncases. For more information, see\n[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/).\n","title":"Partial","info":{"fundeps":[],"arguments":[],"declType":"typeClass","superclasses":[]},"sourceSpan":null},{"children":[],"comments":"`Type` is the kind of all proper types: those that classify value-level terms.\nFor example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`.\n","title":"Type","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"`Constraint` is the kind of type class constraints.\nFor example, a type class declaration like this:\n\n    class Semigroup a where\n      append :: a -> a -> a\n\nhas the kind signature:\n\n    class Semigroup :: Type -> Constraint\n","title":"Constraint","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"`Symbol` is the kind of type-level strings.\n\nConstruct types of this kind using the same literal syntax as documented\nfor strings.\n","title":"Symbol","info":{"kind":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]},"declType":"externData"},"sourceSpan":null},{"children":[],"comments":"`Row` is the kind constructor of label-indexed types which map type-level strings to other types.\nFor example, the kind of `Record` is `Row Type -> Type`, mapping field names to values.\n","title":"Row","info":{"kind":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},"declType":"externData"},"sourceSpan":null}]}
tests/purs/docs/output/PrimSubmodules/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"PrimSubmodules","comments":null,"declarations":[{"children":[{"comments":null,"title":"Lol","info":{"arguments":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"Lol","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",{"annotation":[],"tag":"NamedKind","contents":[["Prim","Ordering"],"Ordering"]}]]},"sourceSpan":{"start":[5,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/PrimSubmodules.purs","end":[5,37]}},{"children":[],"comments":null,"title":"x","info":{"declType":"value","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["PrimSubmodules"],"Lol"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"LT"]}]}},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/PrimSubmodules.purs","end":[7,14]}},{"children":[],"comments":null,"title":"y","info":{"declType":"value","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["PrimSubmodules"],"Lol"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"EQ"]}]}},"sourceSpan":{"start":[10,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/PrimSubmodules.purs","end":[10,14]}}]}+{"reExports":[],"name":"PrimSubmodules","comments":null,"declarations":[{"children":[{"comments":null,"title":"Lol","info":{"arguments":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}],"declType":"dataConstructor"},"sourceSpan":null}],"comments":null,"title":"Lol","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"Ordering"]}]]},"sourceSpan":{"start":[5,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/PrimSubmodules.purs","end":[5,37]}},{"children":[],"comments":null,"title":"x","info":{"declType":"value","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["PrimSubmodules"],"Lol"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"LT"]}]}},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/PrimSubmodules.purs","end":[7,14]}},{"children":[],"comments":null,"title":"y","info":{"declType":"value","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["PrimSubmodules"],"Lol"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","Ordering"],"EQ"]}]}},"sourceSpan":{"start":[10,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/PrimSubmodules.purs","end":[10,14]}}]}
tests/purs/docs/output/SomeTypeClass/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"SomeTypeClass","comments":null,"declarations":[{"children":[{"comments":null,"title":"member","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[5,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/SomeTypeClass.purs","end":[5,14]}}],"comments":null,"title":"SomeClass","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[4,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/SomeTypeClass.purs","end":[5,14]}}]}+{"reExports":[],"name":"SomeTypeClass","comments":null,"declarations":[{"children":[{"comments":null,"title":"member","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[5,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/SomeTypeClass.purs","end":[5,14]}}],"comments":null,"title":"SomeClass","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[4,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/SomeTypeClass.purs","end":[5,14]}}]}
tests/purs/docs/output/Transitive3/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"Transitive3","comments":null,"declarations":[{"children":[],"comments":null,"title":"transitive3","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/Transitive3.purs","end":[3,19]}}]}+{"reExports":[],"name":"Transitive3","comments":null,"declarations":[{"children":[],"comments":null,"title":"transitive3","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/Transitive3.purs","end":[3,19]}}]}
tests/purs/docs/output/TypeClassWithFunDeps/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"TypeClassWithFunDeps","comments":null,"declarations":[{"children":[{"comments":null,"title":"aMember","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},"sourceSpan":{"start":[5,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeClassWithFunDeps.purs","end":[5,20]}}],"comments":null,"title":"TypeClassWithFunDeps","info":{"fundeps":[[["a","b"],["c"]],[["c"],["d","e"]]],"arguments":[["a",null],["b",null],["c",null],["d",null],["e",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[4,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeClassWithFunDeps.purs","end":[5,20]}}]}+{"reExports":[],"name":"TypeClassWithFunDeps","comments":null,"declarations":[{"children":[{"comments":null,"title":"aMember","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},"sourceSpan":{"start":[5,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeClassWithFunDeps.purs","end":[5,20]}}],"comments":null,"title":"TypeClassWithFunDeps","info":{"fundeps":[[["a","b"],["c"]],[["c"],["d","e"]]],"arguments":[["a",null],["b",null],["c",null],["d",null],["e",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[4,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeClassWithFunDeps.purs","end":[5,20]}}]}
tests/purs/docs/output/TypeLevelString/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"TypeLevelString","comments":null,"declarations":[{"children":[{"comments":null,"title":"fooBar","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["Prim","TypeError"],"Fail"],"constraintArgs":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Text"]},{"annotation":[],"tag":"TypeLevelString","contents":"oops"}]}],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Bar"]},{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Foo"]}]}},"sourceSpan":{"start":[9,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[9,49]}}],"comments":null,"title":"Foo","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[5,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[5,9]}},{"children":[{"comments":null,"title":"fooBar","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["Prim","TypeError"],"Fail"],"constraintArgs":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Text"]},{"annotation":[],"tag":"TypeLevelString","contents":"oops"}]}],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Bar"]},{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Foo"]}]}},"sourceSpan":{"start":[9,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[9,49]}}],"comments":null,"title":"Bar","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[7,12]}}]}+{"reExports":[],"name":"TypeLevelString","comments":null,"declarations":[{"children":[{"comments":null,"title":"fooBar","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["Prim","TypeError"],"Fail"],"constraintArgs":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Text"]},{"annotation":[],"tag":"TypeLevelString","contents":"oops"}]}],"constraintKindArgs":[],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Bar"]},{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Foo"]}]}},"sourceSpan":{"start":[9,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[9,49]}}],"comments":null,"title":"Foo","info":{"declType":"data","dataDeclType":"data","typeArguments":[]},"sourceSpan":{"start":[5,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[5,9]}},{"children":[{"comments":null,"title":"fooBar","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["Prim","TypeError"],"Fail"],"constraintArgs":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim","TypeError"],"Text"]},{"annotation":[],"tag":"TypeLevelString","contents":"oops"}]}],"constraintKindArgs":[],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Bar"]},{"annotation":[],"tag":"TypeConstructor","contents":[["TypeLevelString"],"Foo"]}]}},"sourceSpan":{"start":[9,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[9,49]}}],"comments":null,"title":"Bar","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeLevelString.purs","end":[7,12]}}]}
tests/purs/docs/output/TypeOpAliases/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"TypeOpAliases","comments":null,"declarations":[{"children":[],"comments":null,"title":"AltFn","info":{"arguments":[["a",null],["b",null]],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[3,24]}},{"children":[],"comments":null,"title":"type (~>)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Left":"AltFn"}],"fixity":{"associativity":"infixr","precedence":6}},"sourceSpan":{"start":[5,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[5,26]}},{"children":[],"comments":null,"title":"test1","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}]},null]},null]}},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[7,43]}},{"children":[],"comments":null,"title":"test2","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"b"},{"annotation":[],"tag":"TypeVar","contents":"c"}]}]},null]},null]},null]}},"sourceSpan":{"start":[8,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[8,50]}},{"children":[],"comments":null,"title":"test3","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["d",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"b"},{"annotation":[],"tag":"TypeVar","contents":"c"}]}},{"annotation":[],"tag":"TypeVar","contents":"d"}]}]},null]},null]},null]},null]}},"sourceSpan":{"start":[9,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[9,59]}},{"children":[],"comments":null,"title":"test4","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["d",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},{"annotation":[],"tag":"TypeVar","contents":"c"}]}},{"annotation":[],"tag":"TypeVar","contents":"d"}]},null]},null]},null]},null]}},"sourceSpan":{"start":[10,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[10,61]}},{"children":[{"comments":null,"title":"Tuple","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"showTuple","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["TypeOpAliases"],"Show"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Show"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}]}},"sourceSpan":{"start":[27,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[28,24]}},{"comments":null,"title":"testLEither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestL"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}]}},"sourceSpan":{"start":[39,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[40,27]}},{"comments":null,"title":"testREither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestR"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}},"sourceSpan":{"start":[43,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[44,23]}}],"comments":null,"title":"Tuple","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[12,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[12,27]}},{"children":[],"comments":null,"title":"(×)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Right":{"Right":"Tuple"}}],"fixity":{"associativity":"infixl","precedence":6}},"sourceSpan":{"start":[14,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[14,20]}},{"children":[],"comments":null,"title":"type (×)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Left":"Tuple"}],"fixity":{"associativity":"infixl","precedence":6}},"sourceSpan":{"start":[15,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[15,25]}},{"children":[{"comments":null,"title":"Left","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"Right","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"testLEither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestL"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}]}},"sourceSpan":{"start":[39,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[40,27]}},{"comments":null,"title":"testREither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestR"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}},"sourceSpan":{"start":[43,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[44,23]}}],"comments":null,"title":"Either","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[17,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[17,35]}},{"children":[],"comments":null,"title":"type (⊕)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Left":"Either"}],"fixity":{"associativity":"infixl","precedence":5}},"sourceSpan":{"start":[19,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[19,26]}},{"children":[],"comments":null,"title":"third","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"×"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"×"]},{"annotation":[],"tag":"TypeVar","contents":"b"},{"annotation":[],"tag":"TypeVar","contents":"c"}]}]}]},{"annotation":[],"tag":"TypeVar","contents":"c"}]},null]},null]},null]}},"sourceSpan":{"start":[21,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[21,31]}},{"children":[{"comments":null,"title":"show","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}},"sourceSpan":{"start":[25,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[25,22]}},{"comments":null,"title":"showTuple","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["TypeOpAliases"],"Show"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Show"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}]}},"sourceSpan":{"start":[27,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[28,24]}}],"comments":null,"title":"Show","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[24,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[25,22]}},{"children":[{"comments":null,"title":"testL","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[33,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[33,13]}},{"comments":null,"title":"testLEither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestL"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}]}},"sourceSpan":{"start":[39,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[40,27]}}],"comments":null,"title":"TestL","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[32,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[33,13]}},{"children":[{"comments":null,"title":"testR","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[36,3],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[36,13]}},{"comments":null,"title":"testREither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestR"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}},"sourceSpan":{"start":[43,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[44,23]}}],"comments":null,"title":"TestR","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[35,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[36,13]}}]}+{"reExports":[],"name":"TypeOpAliases","comments":null,"declarations":[{"children":[],"comments":null,"title":"AltFn","info":{"arguments":[["a",null],["b",null]],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[3,24]}},{"children":[],"comments":null,"title":"type (~>)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Left":"AltFn"}],"fixity":{"associativity":"infixr","precedence":6}},"sourceSpan":{"start":[5,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[5,26]}},{"children":[],"comments":null,"title":"test1","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}]},null]},null]}},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[7,43]}},{"children":[],"comments":null,"title":"test2","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"b"},{"annotation":[],"tag":"TypeVar","contents":"c"}]}]},null]},null]},null]}},"sourceSpan":{"start":[8,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[8,50]}},{"children":[],"comments":null,"title":"test3","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["d",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"b"},{"annotation":[],"tag":"TypeVar","contents":"c"}]}},{"annotation":[],"tag":"TypeVar","contents":"d"}]}]},null]},null]},null]},null]}},"sourceSpan":{"start":[9,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[9,59]}},{"children":[],"comments":null,"title":"test4","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"ForAll","contents":["d",{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"ParensInType","contents":{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"~>"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}]}},{"annotation":[],"tag":"TypeVar","contents":"c"}]}},{"annotation":[],"tag":"TypeVar","contents":"d"}]},null]},null]},null]},null]}},"sourceSpan":{"start":[10,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[10,61]}},{"children":[{"comments":null,"title":"Tuple","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"showTuple","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["TypeOpAliases"],"Show"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintKindArgs":[],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Show"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}]}},"sourceSpan":{"start":[27,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[28,24]}},{"comments":null,"title":"testLEither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestL"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}]}},"sourceSpan":{"start":[39,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[40,27]}},{"comments":null,"title":"testREither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestR"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}},"sourceSpan":{"start":[43,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[44,23]}}],"comments":null,"title":"Tuple","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[12,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[12,27]}},{"children":[],"comments":null,"title":"(×)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Right":{"Right":"Tuple"}}],"fixity":{"associativity":"infixl","precedence":6}},"sourceSpan":{"start":[14,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[14,20]}},{"children":[],"comments":null,"title":"type (×)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Left":"Tuple"}],"fixity":{"associativity":"infixl","precedence":6}},"sourceSpan":{"start":[15,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[15,25]}},{"children":[{"comments":null,"title":"Left","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"Right","info":{"arguments":[{"annotation":[],"tag":"TypeVar","contents":"b"}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"testLEither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestL"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}]}},"sourceSpan":{"start":[39,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[40,27]}},{"comments":null,"title":"testREither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestR"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}},"sourceSpan":{"start":[43,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[44,23]}}],"comments":null,"title":"Either","info":{"declType":"data","dataDeclType":"data","typeArguments":[["a",null],["b",null]]},"sourceSpan":{"start":[17,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[17,35]}},{"children":[],"comments":null,"title":"type (⊕)","info":{"declType":"alias","alias":[["TypeOpAliases"],{"Left":"Either"}],"fixity":{"associativity":"infixl","precedence":5}},"sourceSpan":{"start":[19,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[19,26]}},{"children":[],"comments":null,"title":"third","info":{"declType":"value","type":{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"ForAll","contents":["b",{"annotation":[],"tag":"ForAll","contents":["c",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"×"]},{"annotation":[],"tag":"TypeVar","contents":"a"},{"annotation":[],"tag":"BinaryNoParensType","contents":[{"annotation":[],"tag":"TypeOp","contents":[["TypeOpAliases"],"×"]},{"annotation":[],"tag":"TypeVar","contents":"b"},{"annotation":[],"tag":"TypeVar","contents":"c"}]}]}]},{"annotation":[],"tag":"TypeVar","contents":"c"}]},null]},null]},null]}},"sourceSpan":{"start":[21,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[21,31]}},{"children":[{"comments":null,"title":"show","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}},"sourceSpan":{"start":[25,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[25,22]}},{"comments":null,"title":"showTuple","info":{"declType":"instance","dependencies":[{"constraintAnn":[],"constraintClass":[["TypeOpAliases"],"Show"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"a"}],"constraintKindArgs":[],"constraintData":null}],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Show"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},{"annotation":[],"tag":"TypeVar","contents":"b"}]}]}},"sourceSpan":{"start":[27,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[28,24]}}],"comments":null,"title":"Show","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[24,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[25,22]}},{"children":[{"comments":null,"title":"testL","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[33,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[33,13]}},{"comments":null,"title":"testLEither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestL"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}]}},"sourceSpan":{"start":[39,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[40,27]}}],"comments":null,"title":"TestL","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[32,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[33,13]}},{"children":[{"comments":null,"title":"testR","info":{"declType":"typeClassMember","type":{"annotation":[],"tag":"TypeVar","contents":"a"}},"sourceSpan":{"start":[36,3],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[36,13]}},{"comments":null,"title":"testREither","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"TestR"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Either"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeOpAliases"],"Tuple"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]}]}},"sourceSpan":{"start":[43,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[44,23]}}],"comments":null,"title":"TestR","info":{"fundeps":[],"arguments":[["a",null]],"declType":"typeClass","superclasses":[]},"sourceSpan":{"start":[35,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeOpAliases.purs","end":[36,13]}}]}
tests/purs/docs/output/TypeSynonym/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"TypeSynonym","comments":null,"declarations":[{"children":[],"comments":null,"title":"MyInt","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeSynonym.purs","end":[3,17]}}]}+{"reExports":[],"name":"TypeSynonym","comments":null,"declarations":[{"children":[],"comments":null,"title":"MyInt","info":{"arguments":[],"declType":"typeSynonym","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[3,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeSynonym.purs","end":[3,17]}}]}
tests/purs/docs/output/TypeSynonymInstance/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"TypeSynonymInstance","comments":null,"declarations":[{"children":[{"comments":null,"title":"MyNT","info":{"arguments":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeSynonym"],"MyInt"]}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"ntMyNT","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Data","Newtype"],"Newtype"]},{"annotation":[],"tag":"TypeConstructor","contents":[["TypeSynonymInstance"],"MyNT"]}]},{"annotation":[],"tag":"TypeWildcard","contents":null}]}},"sourceSpan":{"start":[9,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeSynonymInstance.purs","end":[9,41]}}],"comments":null,"title":"MyNT","info":{"declType":"data","dataDeclType":"newtype","typeArguments":[]},"sourceSpan":{"start":[7,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeSynonymInstance.purs","end":[7,26]}},{"children":[],"comments":null,"title":"foo","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[11,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/TypeSynonymInstance.purs","end":[11,8]}}]}+{"reExports":[],"name":"TypeSynonymInstance","comments":null,"declarations":[{"children":[{"comments":null,"title":"MyNT","info":{"arguments":[{"annotation":[],"tag":"TypeConstructor","contents":[["TypeSynonym"],"MyInt"]}],"declType":"dataConstructor"},"sourceSpan":null},{"comments":null,"title":"ntMyNT","info":{"declType":"instance","dependencies":[],"type":{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Data","Newtype"],"Newtype"]},{"annotation":[],"tag":"TypeConstructor","contents":[["TypeSynonymInstance"],"MyNT"]}]},{"annotation":[],"tag":"TypeWildcard","contents":null}]}},"sourceSpan":{"start":[9,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeSynonymInstance.purs","end":[9,41]}}],"comments":null,"title":"MyNT","info":{"declType":"data","dataDeclType":"newtype","typeArguments":[]},"sourceSpan":{"start":[7,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeSynonymInstance.purs","end":[7,26]}},{"children":[],"comments":null,"title":"foo","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Int"]}},"sourceSpan":{"start":[11,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/TypeSynonymInstance.purs","end":[11,8]}}]}
tests/purs/docs/output/UTF8/docs.json view
@@ -1,1 +1,1 @@-{"reExports":[],"name":"UTF8","comments":null,"declarations":[{"children":[],"comments":"üÜäÄ 😰\n","title":"thing","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prelude"],"Unit"]}},"sourceSpan":{"start":[6,1],"name":"/home/harry/code/purescript/tests/purs/docs/src/UTF8.purs","end":[6,14]}}]}+{"reExports":[],"name":"UTF8","comments":null,"declarations":[{"children":[],"comments":"üÜäÄ 😰\n","title":"thing","info":{"declType":"value","type":{"annotation":[],"tag":"TypeConstructor","contents":[["Prelude"],"Unit"]}},"sourceSpan":{"start":[6,1],"name":"/Users/cyril/Workspace/purescript/purescript/tests/purs/docs/src/UTF8.purs","end":[6,14]}}]}
tests/purs/docs/output/cache-db.json view
@@ -1,1 +1,1 @@-{"Ado":{"src/Ado.purs":["2019-11-02T17:39:14.549052869Z","bd980ae20d61e0e34d23507b1d25598f27407a78cf70084327506f21cc02d85df1bd1b6937459665a8dd9df5bb43ec5947b6e94c16c852aba233747e05a9d58f"]},"ChildDeclOrder":{"src/ChildDeclOrder.purs":["2019-11-02T17:39:14.685050684Z","41a7be97fffe1bbbf925ccb56b68246abb8684b23529fc25e07827b57b32b60ccd82d5c9a2279dc23be1f8803cff8267fa296509b873ec337ffa15ee0e32e2c9"]},"Clash":{"src/Clash.purs":["2019-11-02T17:39:14.685050684Z","7b70d019ea46b72149e185d82bc1345113e8a3977a886aa31ac8a268c6c63c7b93553e1586c45e023e49e485d3f6523a4a11efc8dc70dd8bac5d8b9cac4e4c2d"]},"Clash1":{"src/Clash1.purs":["2019-11-02T17:39:14.685050684Z","bd09c1fd0308ce61d83bef03d3b2366601df559ef8cc9c09f17d963a1bfb2b2e373dcbf5729a3e465c635fbf0035ae09ea3ba58b7844b56586dc3baf9d857bb5"]},"Clash1a":{"src/Clash1a.purs":["2020-05-23T12:09:23.415333385Z","0a93c507e1fab2abaee66e20721e952062466e2597d8eb0c48cad8d351e3204ac157da0c3eebf3d13211cbe379e704245da3535f02bd768adf92f6c1119ca2ee"]},"Clash2":{"src/Clash2.purs":["2019-11-02T17:39:14.685050684Z","10c61c6600084fdcc0ee93608a354fd7efa7edab67ac8cce131e522b597080b2927dc7bb1a6c98765dfc9a30583dc5bea2514d2932554ab1657c664a81a0a81b"]},"Clash2a":{"src/Clash2a.purs":["2020-05-23T12:09:23.415333385Z","d37d26a74b0adec6d8b2de4b75997306e4f199374a1a2b4c1b431a273d16a9e89a634028b428c25aedbc01213bc00574abedaaabaae920f40eaa5be6196c07f6"]},"ConstrainedArgument":{"src/ConstrainedArgument.purs":["2020-05-23T12:09:23.415333385Z","87e0f15cb8e2608fa2ba1a5726eae564526394d07c787975db539c4a496d8889be042c774bd68f975e5fe3fd94a0ab66edac081192a5f5ea581424ea28e36948"]},"Data.Newtype":{"bower_components/purescript-newtype/src/Data/Newtype.purs":["2019-11-02T17:39:14.549052869Z","9a591cfc87fe2fc4e0cd95362fc2a3c12dbf4f7875860036d0d18cf57cdc063b3d72488fe351e2e95196030e89fb133edceed211219be5922f86160fed4965b9"]},"DeclOrder":{"src/DeclOrder.purs":["2019-11-02T17:39:14.685050684Z","a8c6ab9c335037c255ae6e0124a107f2e2462c2eebc2ff3637273ba436f2f3589ae203919ff5c8c61106b0542114ba3eba66426d8b5e316089bc1f4efb72643a"]},"DeclOrderNoExportList":{"src/DeclOrderNoExportList.purs":["2019-11-02T17:39:14.685050684Z","379def50dfd7a01dd2b057c707ea8ee53147d41c7dc28083c3827ccc213816840fd26d784a78bd1eabd105231e5479c7bfeebfcb03d1e2f3e8174ab173d740c4"]},"Desugar":{"src/Desugar.purs":["2019-11-02T17:39:14.685050684Z","50ceefe5cbac286908cc7070f4e94f57c62b5c91245d5a8c66d7f4565e3d037e4cf11524c4c790664588a0a5c4216390b5138be9ec93e14d0f82a2c59c8f561a"]},"DocComments":{"src/DocComments.purs":["2019-11-02T17:39:14.685050684Z","220498626601722feb58dd23dd80ac970f6ba7df8e8c2ad604ed833933f6b36219fb5f1d0b9963ffc7e9314043760055ab547fac5784a28416a4851f257a635b"]},"DocCommentsClassMethod":{"src/DocCommentsClassMethod.purs":["2019-11-02T17:39:14.549052869Z","f55a03f2b2624a9ca01adc8372bad4b7e46e8ef1a52ec41c5992767146c9a2354320a3a38587cbf2e78fec118430f193fdcb1cdd9600cd9f755dbbc2e36e46b7"]},"DocCommentsDataConstructor":{"src/DocCommentsDataConstructor.purs":["2019-11-02T17:39:14.549052869Z","68d644ce63642bd55d8338e78e0070c409d3c970a2967338cf612d7a3217813fd98a08e1905776572819cadbc08cdd4bec4a7c1473974a9f3f5d5b1149d33257"]},"DuplicateNames":{"src/DuplicateNames.purs":["2019-11-02T17:39:14.685050684Z","5652f5da0ae79185fb27bce13793bd7752779364e0d1c7c56be2d213853c26ad0abff8536a0d34090a079980e498c837026521efe4a8cfc1b1a16ec70c724eed"]},"Example":{"src/Example.purs":["2019-11-02T17:39:14.685050684Z","3b700a99cc5ee257009553d27a2d25f71f68f006e9deec2b3578f01c7fe4e77de1e929dc110dfcd51d68685ad3ab6b09b0147fe63719861e8a9e480a64e286d9"]},"Example2":{"src/Example2.purs":["2019-11-02T17:39:14.685050684Z","6a479db4e40f66b1e29889516a55cfb22b15b2b8c4531b9cf20307a965af3dc0a6dab4eccc31cca4eacaaa158a01c58ff995ac6f01b2e1ed5571c44fa3bf2536"]},"ExplicitExport":{"src/ExplicitExport.purs":["2019-11-02T17:39:14.685050684Z","fe733409eb325c971f84b6414a1fc9e08793d2271eebcd670ceefd5c5aef837ee76ec5cb5bed96d87ea791a7521c76668a71be5cd8fb14209414893dc20d3d47"]},"ExplicitTypeSignatures":{"src/ExplicitTypeSignatures.purs":["2019-11-02T17:39:14.685050684Z","78a70441c9966f04c6c32a74cbba299f0f8ea870c664e738eb0d8f8cc5929edb7bb697170fc306c9ee69fa4e2f0112af15c8bdb29d63645cdf6f2916a122a0bd"]},"ImportedTwice":{"src/ImportedTwice.purs":["2019-11-02T17:39:14.685050684Z","be9a0cb1e75c689c3af6817a5750862915e70a0017476cce4c539a3c7ce5b33554aa14d2668bd131b89bb28d65b5ddaa79abfb2a538d606f1b11b5ef0ec79067"]},"ImportedTwiceA":{"src/ImportedTwiceA.purs":["2019-11-02T17:39:14.685050684Z","883c8abaefe0dbacbcdea4c53eab41da26687680274419720b1e5d6510bf5127b7ba06df23515ad34f7ffc4626f0064d7867e2b4a5f255a6b573d219926364de"]},"ImportedTwiceB":{"src/ImportedTwiceB.purs":["2019-11-02T17:39:14.685050684Z","48cc2ac8ce40b1d0e3782fcb8ec798cf9c4838a595148055f1bb830d9b07d58780170ad3f8a90f43ac561aff2c52a5d8793480526a4768ebf1c8af1ff1b68751"]},"MultiVirtual":{"src/MultiVirtual.purs":["2019-11-02T17:39:14.685050684Z","31bc7e2c2ebee39dbc89536db51493a2cb1843a9e1aed8b288ef16660877fd1abd5f4224d3325a415aabcf79bd5fe76ebb9257738b0193a50c79a20d48b5ab29"]},"MultiVirtual1":{"src/MultiVirtual1.purs":["2019-11-02T17:39:14.685050684Z","23f7975f7494bb84f9fc6fde9071ce04e86df774d81e2b027a85ab46c8237f9921ee926f4a4ad3e03c7799e485ce39e542d1dd94953c50c0d58ea0003cfc3842"]},"MultiVirtual2":{"src/MultiVirtual2.purs":["2019-11-02T17:39:14.685050684Z","f424ed7c0db709b6bb1e57f87069f484fd0db9dddd0475cd15d36bd58743e98729c42efd2df6ee8fbd18609c36c2247cf3428a5a7f1f5ed11e233a2b134990ba"]},"MultiVirtual3":{"src/MultiVirtual3.purs":["2019-11-02T17:39:14.685050684Z","a42415e3b8309bfa81ef127c61dba6f4001188dcee160a8e2f73399179a11262f12daf0205d6bec38fc605b637550f16b62e84a0f2a0f6999355d56ff2540405"]},"NewOperators":{"src/NewOperators.purs":["2019-11-02T17:39:14.685050684Z","f74cae05c73db1f629e199692c517866fb1683caab3c4509657a371733f30319f0c505ed57208757b3e43795aab5191000c834a501d9bd2bf0e58875873c5c40"]},"NewOperators2":{"src/NewOperators2.purs":["2019-11-02T17:39:14.685050684Z","c551a91aa792fb9ee4b5758c010761a53d4a14b8fbaa6b76b6bd9a318a28f245c9b090bdc4f77b904c873d9b71d59fbad3ccd9ad7c8773f5c1e57a22a0204844"]},"NotAllCtors":{"src/NotAllCtors.purs":["2019-11-02T17:39:14.685050684Z","6e0af26cf897b5dd6e8dd4d75988e5607118f6fdd5219aa192f477cc4d760d504bdec930d46af82a44950e3de4fe6c37664a4560a523a45097503b85c161bd96"]},"Prelude":{"bower_components/purescript-prelude/src/Prelude.purs":["2019-11-02T17:39:14.685050684Z","7eb0b2f9b7aec29693f79be4642ccea792b1f54c7022a4f1395fb8f3a9b1ad6cbfb2e7685940b89ab21890c02949ec90d4823bd5c36a6b566ca9cb8ec561958f"]},"PrimSubmodules":{"src/PrimSubmodules.purs":["2019-11-02T17:39:14.549052869Z","cea3766e9920985a3458c6f7af4a19dbe435527d0b0e1d465e8d7362ebd14cea569e820c3849e45c88f368ced11b1e948276f86dc6f0dc0e0eac78c7df2afa50"]},"ReExportedTypeClass":{"src/ReExportedTypeClass.purs":["2019-11-02T17:39:14.685050684Z","1cc581d68e1ce113162ab851872e73645807f0deb1d2b970ebc04b314184fe30c3431212ffcf9eec09a56a2291e0050750ac6905f1884bc74d406d0323c4f804"]},"SolitaryTypeClassMember":{"src/SolitaryTypeClassMember.purs":["2019-11-02T17:39:14.685050684Z","f627c589b0a8f58d7bfdf28ecf87891a74e64e8399ce0ab645b7c58049fddc1ea3cbb3c34b862bec8576108d5258d9548ecfbbab98598671cc645a3f358ac852"]},"SomeTypeClass":{"src/SomeTypeClass.purs":["2019-11-02T17:39:14.685050684Z","d09fc77e6c6350e7e4941e2911e012271a49db4a75c57cf738d5865ca622d60b69337f969aa02b13fc869484cba00479212e4b8dbcb458c5723e7a5d73888368"]},"Transitive1":{"src/Transitive1.purs":["2019-11-02T17:39:14.685050684Z","42681f3d0fa143d36474d1cb2f464820bdb907bbc432cd91349f6acdd82657ecb4d9ad1d075c96c551bed37dada4615dd3ff64f912f2cc8a6d99b5e02ee51979"]},"Transitive2":{"src/Transitive2.purs":["2019-11-02T17:39:14.685050684Z","110a1bae420e0f0c05e9846fad483a1d035dfc3ba82c2cd81e44f548fd97965055b1a687ab86256f8cb6a3d79b4c4abe6f45d4728bbc04a7a1b0fedbca115b1e"]},"Transitive3":{"src/Transitive3.purs":["2019-11-02T17:39:14.685050684Z","65f7bb366ac8fab63084ff0229c9d55293db8126b539ff2cb53e511505995f426d50f4cca7d1f61fc53aaaaeed9d72791f9d9f12cc569d92e7bbe1d1908b093c"]},"TypeClassWithFunDeps":{"src/TypeClassWithFunDeps.purs":["2019-11-02T17:39:14.685050684Z","c828f194c8c679d97425ed7e04eb3c9bb04bc4c32542d7d6d7e4a36c6c734eb8ba1ef472ad2b0085d9a042a0724648b85a4605d8fe4995e1a32839b1fb1f0f23"]},"TypeClassWithoutMembers":{"src/TypeClassWithoutMembers.purs":["2019-11-02T17:39:14.685050684Z","3eac42652ce295ee47c340c4b86c91d0f6a8ad1f81824475fa4fc4ae8fd8bb77ceee6a46e31bebe9d2e8a980a7923432b41b0eff5cbf75580ee149e7d997e098"]},"TypeClassWithoutMembersIntermediate":{"src/TypeClassWithoutMembersIntermediate.purs":["2019-11-02T17:39:14.685050684Z","76d65083da1f6240b4c3b6c910af1326b9b9a538f4eb278b00ddf0bf67d9547c1cab0fae7661bbe4af6e7ecdea9fd26cc9ff9ea5b289d3c3994b3ccb3d099ba8"]},"TypeLevelString":{"src/TypeLevelString.purs":["2019-11-02T17:39:14.549052869Z","361dc3825ebd3efcd9a53dd900cc623f5eca14df82afc93f4d485d8b38e51eb0a72929b6cfb783b3d5c9bef46e6fd18c139fdbd10de484beb335e09ecee79388"]},"TypeOpAliases":{"src/TypeOpAliases.purs":["2019-11-02T17:39:14.685050684Z","5f1279d355f0e8f8c7d063950007ba060f0afdb83524fa10361f389d25fdacdf149c907cbdd94cf3d1a77751903701f22ba377203cd3b5d0c40e504699f94249"]},"TypeSynonym":{"src/TypeSynonym.purs":["2019-11-02T17:39:14.549052869Z","d1a0af1c2592e7f150bb0bf1dca4fc82ffe95b4f96be611408828d105d28bb6a4243a4c2799b1c35875a352e51a19464e4507b9c81d9cd34f0f55f8c94898ed9"]},"TypeSynonymInstance":{"src/TypeSynonymInstance.purs":["2019-11-02T17:39:14.549052869Z","336ba7262428a526f3824306f4ac472aebf637181b8aa23d823e6e70641539a14d57b52272d844af3e3a7fa85cdf4094042e464b61622a5a1c290ee8a6684733"]},"UTF8":{"src/UTF8.purs":["2019-11-02T17:39:14.685050684Z","60771c6d4974ef36414775e5a2511e99d08d5ba3945b010d7a399b77b88b310e10ad7d0016f7946ca3f524e7bbd1dce3575f7b2d81f8154bde197a3da411a624"]},"Virtual":{"src/Virtual.purs":["2019-11-02T17:39:14.685050684Z","a1e01c8b1a7c86c86942611649702ebf6689cf7559ce9ca0ba66052eafe64826b0770b33089e72cc26a3c90d75bcf62e0b75a6a90e085e70a6ec946b16456de2"]}}+{"Ado":{"src/Ado.purs":["2019-04-24T09:09:54.27478525Z","bd980ae20d61e0e34d23507b1d25598f27407a78cf70084327506f21cc02d85df1bd1b6937459665a8dd9df5bb43ec5947b6e94c16c852aba233747e05a9d58f"]},"ChildDeclOrder":{"src/ChildDeclOrder.purs":["2019-04-24T09:09:54.274929823Z","41a7be97fffe1bbbf925ccb56b68246abb8684b23529fc25e07827b57b32b60ccd82d5c9a2279dc23be1f8803cff8267fa296509b873ec337ffa15ee0e32e2c9"]},"Clash":{"src/Clash.purs":["2019-04-24T09:09:54.275090035Z","7b70d019ea46b72149e185d82bc1345113e8a3977a886aa31ac8a268c6c63c7b93553e1586c45e023e49e485d3f6523a4a11efc8dc70dd8bac5d8b9cac4e4c2d"]},"Clash1":{"src/Clash1.purs":["2019-04-24T09:09:54.275219097Z","bd09c1fd0308ce61d83bef03d3b2366601df559ef8cc9c09f17d963a1bfb2b2e373dcbf5729a3e465c635fbf0035ae09ea3ba58b7844b56586dc3baf9d857bb5"]},"Clash1a":{"src/Clash1a.purs":["2021-02-06T11:35:58.334651515Z","b5c374c74a46d3f633c948de256e299dc2713857ce09441b5ae2f03afdd0468610088f39854f69848c1c9aecf3441b1b39e0919e499280a19d69b83de07d5d0b"]},"Clash2":{"src/Clash2.purs":["2019-04-24T09:09:54.275516137Z","10c61c6600084fdcc0ee93608a354fd7efa7edab67ac8cce131e522b597080b2927dc7bb1a6c98765dfc9a30583dc5bea2514d2932554ab1657c664a81a0a81b"]},"Clash2a":{"src/Clash2a.purs":["2021-02-06T11:35:58.334894002Z","b002aac5be65ac1cb55d10518840293780ea6d4a42b045172544ab3478ea83252f0672f0e1d4ad1599db3955f55202738ba1ee254b8ad94e914fc43fc1f6750f"]},"ConstrainedArgument":{"src/ConstrainedArgument.purs":["2021-02-06T11:35:58.335113696Z","6caa6cc505c6574957afe8e703f6e9869211e9c0a0676ba36a79d2a8b7e3c2c1570aae714cd6acc37e5b206745941460c1cf370a3bbd783c79b89351681ec890"]},"Data.Newtype":{"bower_components/purescript-newtype/src/Data/Newtype.purs":["2021-02-06T11:35:58.334117908Z","408eb6f95efb52faff05d73c757d21cebdd3b58dce3f5b8cfb5f0772224ca7e6ff9b5df0ab9ea40ce0f8448664fe56028af844b2c5dc32e5712b7d9d1541f2b7"]},"DeclOrder":{"src/DeclOrder.purs":["2019-04-24T09:09:54.27590838Z","a8c6ab9c335037c255ae6e0124a107f2e2462c2eebc2ff3637273ba436f2f3589ae203919ff5c8c61106b0542114ba3eba66426d8b5e316089bc1f4efb72643a"]},"DeclOrderNoExportList":{"src/DeclOrderNoExportList.purs":["2019-04-24T09:09:54.276065983Z","379def50dfd7a01dd2b057c707ea8ee53147d41c7dc28083c3827ccc213816840fd26d784a78bd1eabd105231e5479c7bfeebfcb03d1e2f3e8174ab173d740c4"]},"Desugar":{"src/Desugar.purs":["2019-04-24T09:09:54.276188438Z","50ceefe5cbac286908cc7070f4e94f57c62b5c91245d5a8c66d7f4565e3d037e4cf11524c4c790664588a0a5c4216390b5138be9ec93e14d0f82a2c59c8f561a"]},"DocComments":{"src/DocComments.purs":["2019-04-24T09:09:54.276314187Z","220498626601722feb58dd23dd80ac970f6ba7df8e8c2ad604ed833933f6b36219fb5f1d0b9963ffc7e9314043760055ab547fac5784a28416a4851f257a635b"]},"DocCommentsClassMethod":{"src/DocCommentsClassMethod.purs":["2020-02-01T18:09:36.124932649Z","f55a03f2b2624a9ca01adc8372bad4b7e46e8ef1a52ec41c5992767146c9a2354320a3a38587cbf2e78fec118430f193fdcb1cdd9600cd9f755dbbc2e36e46b7"]},"DocCommentsDataConstructor":{"src/DocCommentsDataConstructor.purs":["2020-02-01T18:09:36.125052344Z","68d644ce63642bd55d8338e78e0070c409d3c970a2967338cf612d7a3217813fd98a08e1905776572819cadbc08cdd4bec4a7c1473974a9f3f5d5b1149d33257"]},"DuplicateNames":{"src/DuplicateNames.purs":["2019-04-24T09:09:54.276463945Z","5652f5da0ae79185fb27bce13793bd7752779364e0d1c7c56be2d213853c26ad0abff8536a0d34090a079980e498c837026521efe4a8cfc1b1a16ec70c724eed"]},"Example":{"src/Example.purs":["2019-04-24T09:09:54.27659495Z","3b700a99cc5ee257009553d27a2d25f71f68f006e9deec2b3578f01c7fe4e77de1e929dc110dfcd51d68685ad3ab6b09b0147fe63719861e8a9e480a64e286d9"]},"Example2":{"src/Example2.purs":["2019-04-24T09:09:54.276714764Z","6a479db4e40f66b1e29889516a55cfb22b15b2b8c4531b9cf20307a965af3dc0a6dab4eccc31cca4eacaaa158a01c58ff995ac6f01b2e1ed5571c44fa3bf2536"]},"ExplicitExport":{"src/ExplicitExport.purs":["2019-04-24T09:09:54.27683672Z","fe733409eb325c971f84b6414a1fc9e08793d2271eebcd670ceefd5c5aef837ee76ec5cb5bed96d87ea791a7521c76668a71be5cd8fb14209414893dc20d3d47"]},"ExplicitTypeSignatures":{"src/ExplicitTypeSignatures.purs":["2019-04-24T09:09:54.276985598Z","78a70441c9966f04c6c32a74cbba299f0f8ea870c664e738eb0d8f8cc5929edb7bb697170fc306c9ee69fa4e2f0112af15c8bdb29d63645cdf6f2916a122a0bd"]},"ImportedTwice":{"src/ImportedTwice.purs":["2019-04-24T09:09:54.27714202Z","be9a0cb1e75c689c3af6817a5750862915e70a0017476cce4c539a3c7ce5b33554aa14d2668bd131b89bb28d65b5ddaa79abfb2a538d606f1b11b5ef0ec79067"]},"ImportedTwiceA":{"src/ImportedTwiceA.purs":["2019-04-24T09:09:54.277262129Z","883c8abaefe0dbacbcdea4c53eab41da26687680274419720b1e5d6510bf5127b7ba06df23515ad34f7ffc4626f0064d7867e2b4a5f255a6b573d219926364de"]},"ImportedTwiceB":{"src/ImportedTwiceB.purs":["2019-04-24T09:09:54.277380444Z","48cc2ac8ce40b1d0e3782fcb8ec798cf9c4838a595148055f1bb830d9b07d58780170ad3f8a90f43ac561aff2c52a5d8793480526a4768ebf1c8af1ff1b68751"]},"MultiVirtual":{"src/MultiVirtual.purs":["2019-04-24T09:09:54.27750662Z","31bc7e2c2ebee39dbc89536db51493a2cb1843a9e1aed8b288ef16660877fd1abd5f4224d3325a415aabcf79bd5fe76ebb9257738b0193a50c79a20d48b5ab29"]},"MultiVirtual1":{"src/MultiVirtual1.purs":["2019-04-24T09:09:54.277638612Z","23f7975f7494bb84f9fc6fde9071ce04e86df774d81e2b027a85ab46c8237f9921ee926f4a4ad3e03c7799e485ce39e542d1dd94953c50c0d58ea0003cfc3842"]},"MultiVirtual2":{"src/MultiVirtual2.purs":["2019-04-24T09:09:54.277770724Z","f424ed7c0db709b6bb1e57f87069f484fd0db9dddd0475cd15d36bd58743e98729c42efd2df6ee8fbd18609c36c2247cf3428a5a7f1f5ed11e233a2b134990ba"]},"MultiVirtual3":{"src/MultiVirtual3.purs":["2019-04-24T09:09:54.277910925Z","a42415e3b8309bfa81ef127c61dba6f4001188dcee160a8e2f73399179a11262f12daf0205d6bec38fc605b637550f16b62e84a0f2a0f6999355d56ff2540405"]},"NewOperators":{"src/NewOperators.purs":["2019-04-24T09:09:54.278055838Z","f74cae05c73db1f629e199692c517866fb1683caab3c4509657a371733f30319f0c505ed57208757b3e43795aab5191000c834a501d9bd2bf0e58875873c5c40"]},"NewOperators2":{"src/NewOperators2.purs":["2019-04-24T09:09:54.278214185Z","c551a91aa792fb9ee4b5758c010761a53d4a14b8fbaa6b76b6bd9a318a28f245c9b090bdc4f77b904c873d9b71d59fbad3ccd9ad7c8773f5c1e57a22a0204844"]},"NotAllCtors":{"src/NotAllCtors.purs":["2019-04-24T09:09:54.278352368Z","6e0af26cf897b5dd6e8dd4d75988e5607118f6fdd5219aa192f477cc4d760d504bdec930d46af82a44950e3de4fe6c37664a4560a523a45097503b85c161bd96"]},"Prelude":{"bower_components/purescript-prelude/src/Prelude.purs":["2020-07-12T20:41:53.638763239Z","7eb0b2f9b7aec29693f79be4642ccea792b1f54c7022a4f1395fb8f3a9b1ad6cbfb2e7685940b89ab21890c02949ec90d4823bd5c36a6b566ca9cb8ec561958f"]},"PrimSubmodules":{"src/PrimSubmodules.purs":["2019-04-24T09:09:54.278494952Z","cea3766e9920985a3458c6f7af4a19dbe435527d0b0e1d465e8d7362ebd14cea569e820c3849e45c88f368ced11b1e948276f86dc6f0dc0e0eac78c7df2afa50"]},"ReExportedTypeClass":{"src/ReExportedTypeClass.purs":["2019-04-24T09:09:54.278611597Z","1cc581d68e1ce113162ab851872e73645807f0deb1d2b970ebc04b314184fe30c3431212ffcf9eec09a56a2291e0050750ac6905f1884bc74d406d0323c4f804"]},"SolitaryTypeClassMember":{"src/SolitaryTypeClassMember.purs":["2019-04-24T09:09:54.278739049Z","f627c589b0a8f58d7bfdf28ecf87891a74e64e8399ce0ab645b7c58049fddc1ea3cbb3c34b862bec8576108d5258d9548ecfbbab98598671cc645a3f358ac852"]},"SomeTypeClass":{"src/SomeTypeClass.purs":["2019-04-24T09:09:54.27901077Z","d09fc77e6c6350e7e4941e2911e012271a49db4a75c57cf738d5865ca622d60b69337f969aa02b13fc869484cba00479212e4b8dbcb458c5723e7a5d73888368"]},"Transitive1":{"src/Transitive1.purs":["2019-04-24T09:09:54.279201602Z","42681f3d0fa143d36474d1cb2f464820bdb907bbc432cd91349f6acdd82657ecb4d9ad1d075c96c551bed37dada4615dd3ff64f912f2cc8a6d99b5e02ee51979"]},"Transitive2":{"src/Transitive2.purs":["2019-04-24T09:09:54.279345485Z","110a1bae420e0f0c05e9846fad483a1d035dfc3ba82c2cd81e44f548fd97965055b1a687ab86256f8cb6a3d79b4c4abe6f45d4728bbc04a7a1b0fedbca115b1e"]},"Transitive3":{"src/Transitive3.purs":["2019-04-24T09:09:54.279478783Z","65f7bb366ac8fab63084ff0229c9d55293db8126b539ff2cb53e511505995f426d50f4cca7d1f61fc53aaaaeed9d72791f9d9f12cc569d92e7bbe1d1908b093c"]},"TypeClassWithFunDeps":{"src/TypeClassWithFunDeps.purs":["2019-04-24T09:09:54.27962371Z","c828f194c8c679d97425ed7e04eb3c9bb04bc4c32542d7d6d7e4a36c6c734eb8ba1ef472ad2b0085d9a042a0724648b85a4605d8fe4995e1a32839b1fb1f0f23"]},"TypeClassWithoutMembers":{"src/TypeClassWithoutMembers.purs":["2019-04-24T09:09:54.279765348Z","3eac42652ce295ee47c340c4b86c91d0f6a8ad1f81824475fa4fc4ae8fd8bb77ceee6a46e31bebe9d2e8a980a7923432b41b0eff5cbf75580ee149e7d997e098"]},"TypeClassWithoutMembersIntermediate":{"src/TypeClassWithoutMembersIntermediate.purs":["2019-04-24T09:09:54.279908003Z","76d65083da1f6240b4c3b6c910af1326b9b9a538f4eb278b00ddf0bf67d9547c1cab0fae7661bbe4af6e7ecdea9fd26cc9ff9ea5b289d3c3994b3ccb3d099ba8"]},"TypeLevelString":{"src/TypeLevelString.purs":["2019-04-24T09:09:54.280076809Z","361dc3825ebd3efcd9a53dd900cc623f5eca14df82afc93f4d485d8b38e51eb0a72929b6cfb783b3d5c9bef46e6fd18c139fdbd10de484beb335e09ecee79388"]},"TypeOpAliases":{"src/TypeOpAliases.purs":["2019-04-24T09:09:54.280229226Z","5f1279d355f0e8f8c7d063950007ba060f0afdb83524fa10361f389d25fdacdf149c907cbdd94cf3d1a77751903701f22ba377203cd3b5d0c40e504699f94249"]},"TypeSynonym":{"src/TypeSynonym.purs":["2020-02-01T18:09:36.125160261Z","d1a0af1c2592e7f150bb0bf1dca4fc82ffe95b4f96be611408828d105d28bb6a4243a4c2799b1c35875a352e51a19464e4507b9c81d9cd34f0f55f8c94898ed9"]},"TypeSynonymInstance":{"src/TypeSynonymInstance.purs":["2020-02-01T18:09:36.125294221Z","336ba7262428a526f3824306f4ac472aebf637181b8aa23d823e6e70641539a14d57b52272d844af3e3a7fa85cdf4094042e464b61622a5a1c290ee8a6684733"]},"UTF8":{"src/UTF8.purs":["2019-04-24T09:09:54.280465389Z","60771c6d4974ef36414775e5a2511e99d08d5ba3945b010d7a399b77b88b310e10ad7d0016f7946ca3f524e7bbd1dce3575f7b2d81f8154bde197a3da411a624"]},"Virtual":{"src/Virtual.purs":["2019-04-24T09:09:54.280587257Z","a1e01c8b1a7c86c86942611649702ebf6689cf7559ce9ca0ba66052eafe64826b0770b33089e72cc26a3c90d75bcf62e0b75a6a90e085e70a6ec946b16456de2"]}}
tests/purs/docs/src/Clash1a.purs view
@@ -3,7 +3,7 @@ value :: Int value = 0 -type Type = Int+type Type' = Int  class TypeClass a where   typeClassMember :: a
tests/purs/docs/src/Clash2a.purs view
@@ -3,7 +3,7 @@ value :: String value = "hello" -type Type = String+type Type' = String  class TypeClass a b where   typeClassMember :: a -> b
tests/purs/docs/src/ConstrainedArgument.purs view
@@ -1,6 +1,6 @@ module ConstrainedArgument where -class Foo t+class Foo (t :: Type)  type WithoutArgs      = forall a. (Partial => a) -> a type WithArgs         = forall a. (Foo a => a) -> a
+ tests/purs/failing/1071.out view
@@ -0,0 +1,22 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/1071.purs:7:18 - 7:23 (line 7, column 18 - line 7, column 23)++  Could not match kind+  [33m                    [0m+  [33m  Type -> Constraint[0m+  [33m                    [0m+  with kind+  [33m            [0m+  [33m  Constraint[0m+  [33m            [0m++while checking that type [33mFoo a[0m+  has kind [33mConstraint[0m+while inferring the kind of [33mFoo a => a -> a[0m+while inferring the kind of [33mforall a. Foo a => a -> a[0m+in value declaration [33mbar[0m++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1169.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mTest[0m+at tests/purs/failing/1169.purs:12:8 - 12:15 (line 12, column 8 - line 12, column 15)++  Data constructor [33mTest.Inner[0m was given 1 arguments in a case expression, but expected 2 arguments.+  This problem can be fixed by giving [33mTest.Inner[0m 2 arguments.++while checking that expression [33mcase $1 of         [0m+                               [33m  (Inner _) -> true[0m+  has type [33mBoolean[0m+in value declaration [33mtest2[0m++See https://github.com/purescript/documentation/blob/master/errors/IncorrectConstructorArity.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1175.out view
@@ -0,0 +1,22 @@+Error found:+in module [33mX[0m+at tests/purs/failing/1175.purs:11:11 - 11:12 (line 11, column 11 - line 11, column 12)++  Could not match type+  [33m     [0m+  [33m  Int[0m+  [33m     [0m+  with type+  [33m        [0m+  [33m  String[0m+  [33m        [0m++while checking that type [33mInt[0m+  is at least as general as type [33mString[0m+while checking that expression [33m1[0m+  has type [33mString[0m+in value declaration [33mf[0m++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1310.out view
@@ -0,0 +1,25 @@+Error found:+in module [33mIssue1310[0m+at tests/purs/failing/1310.purs:18:8 - 18:31 (line 18, column 8 - line 18, column 31)++  No type class instance was found for+  [33m                         [0m+  [33m  Issue1310.Inject Oops  [0m+  [33m                   Effect[0m+  [33m                         [0m++while applying a function [33minj[0m+  of type [33mInject @t0 t1 t2 => t1 t3 -> t2 t3[0m+  to argument [33mOops (log "Oops")[0m+while checking that expression [33minj (Oops (log "Oops"))[0m+  has type [33mEffect Unit[0m+in value declaration [33mmain[0m++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type+      [33mt2[0m is an unknown type+      [33mt3[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1570.out view
@@ -0,0 +1,23 @@+Error found:+in module [33mM[0m+at tests/purs/failing/1570.purs:6:10 - 6:16 (line 6, column 10 - line 6, column 16)++  In a type-annotated expression [33mx :: t[0m, the type [33mt[0m must have kind [33mType[0m.+  The error arises from the type+  [33m   [0m+  [33m  F[0m+  [33m   [0m+  having the kind+  [33m              [0m+  [33m  Type -> Type[0m+  [33m              [0m+  instead.++while inferring the type of [33m\$0 ->      [0m+                            [33m  case $0 of[0m+                            [33m    x -> x  [0m+in value declaration [33mtest[0m++See https://github.com/purescript/documentation/blob/master/errors/ExpectedType.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1733.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/1733.purs:6:8 - 6:25 (line 6, column 8 - line 6, column 25)++  Unknown value [33mThing.doesntExist[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1825.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/1825.purs:8:11 - 8:12 (line 8, column 11 - line 8, column 12)++  Unknown value [33ma[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/1881.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/1881.purs:5:1 - 5:1 (line 5, column 1 - line 5, column 1)++  Unable to parse module:+  Unexpected or mismatched indentation+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2109-bind.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2109-bind.purs:8:3 - 8:14 (line 8, column 3 - line 8, column 14)++  Unknown value [33mbind[0m. You're probably using do-notation, which the compiler replaces with calls to the [33mbind[0m function. Please import [33mbind[0m from module [33mPrelude[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2109-bind.purs view
@@ -0,0 +1,9 @@+-- @shouldFailWith UnknownName+module Main where++import Data.Maybe (Maybe(..))+import Prelude (pure)++x = do+  x <- Just 1+  pure x
+ tests/purs/failing/2109-discard.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2109-discard.purs:7:3 - 7:12 (line 7, column 3 - line 7, column 12)++  Unknown value [33mdiscard[0m. You're probably using do-notation, which the compiler replaces with calls to the [33mdiscard[0m function. Please import [33mdiscard[0m from module [33mPrelude[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2109-discard.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith UnknownName+module Main where++import Prelude (unit, pure)++main = do+  pure unit+  pure unit
+ tests/purs/failing/2109-negate.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2109-negate.purs:4:5 - 4:7 (line 4, column 5 - line 4, column 7)++  Unknown value [33mnegate[0m. You're probably using numeric negation (the unary [33m-[0m operator), which the compiler replaces with calls to the [33mnegate[0m function. Please import [33mnegate[0m from module [33mPrelude[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2109-negate.purs view
@@ -0,0 +1,4 @@+-- @shouldFailWith UnknownName+module Main where++x = -5
+ tests/purs/failing/2128-class.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2128-class.purs:5:15 - 5:18 (line 5, column 15 - line 5, column 18)++  Unable to parse module:+  Unexpected token '!!!'+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2128-instance.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2128-instance.purs:8:9 - 8:12 (line 8, column 9 - line 8, column 12)++  Unable to parse module:+  Unexpected token '!!!'+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2197-shouldFail.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2197-shouldFail.purs:9:6 - 9:12 (line 9, column 6 - line 9, column 12)++  Conflicting definitions are in scope for type [33mNumber[0m from the following modules:++    [33mMain[0m+    [33mPrim[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2197-shouldFail2.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2197-shouldFail2.purs:6:6 - 6:12 (line 6, column 6 - line 6, column 12)++  Unknown type [33mNumber[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2378.out view
@@ -0,0 +1,18 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2378.purs:6:1 - 6:25 (line 6, column 1 - line 6, column 25)++  Orphan instance [33mfooX[0m found for+  [33m             [0m+  [33m  Lib.Foo "x"[0m+  [33m             [0m+  This problem can be resolved by declaring the instance in [33mLib[0m, or by defining the instance on a newtype wrapper.++in type class instance+[33m             [0m+[33m  Lib.Foo "x"[0m+[33m             [0m++See https://github.com/purescript/documentation/blob/master/errors/OrphanInstance.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2379.out view
@@ -0,0 +1,31 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2379.purs:6:8 - 6:19 (line 6, column 8 - line 6, column 19)++  No type class instance was found for class+  [33m       [0m+  [33m  Lib.Y[0m+  [33m       [0m+  because the class was not in scope. Perhaps it was not exported.++while solving type class constraint+[33m           [0m+[33m  Lib.Y Int[0m+[33m           [0m+while applying a function [33mx[0m+  of type [33mX t0 => t0 -> String[0m+  to argument [33m[ 1[0m+              [33m, 2[0m+              [33m, 3[0m+              [33m]  [0m+while inferring the type of [33mx [ 1[0m+                            [33m  , 2[0m+                            [33m  , 3[0m+                            [33m  ]  [0m+in value declaration [33mtest[0m++where [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/UnknownClass.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2434.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2434.purs:5:13 - 5:14 (line 5, column 13 - line 5, column 14)++  Unable to parse module:+  Illegal astral code point in character literal+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2534.out view
@@ -0,0 +1,21 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2534.purs:8:14 - 8:18 (line 8, column 14 - line 8, column 18)++  An infinite type was inferred for an expression:+  [33m          [0m+  [33m  Array t0[0m+  [33m          [0m++while trying to match type [33mArray t1[0m+  with type [33mt0[0m+while checking that expression [33mxs[0m+  has type [33mt0[0m+in value declaration [33mfoo[0m++where [33mt1[0m is an unknown type+      [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/InfiniteType.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2542.out view
@@ -0,0 +1,22 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2542.purs:8:16 - 8:17 (line 8, column 16 - line 8, column 17)++  Type variable [33ma[0m is undefined.++while inferring the kind of [33ma[0m+while checking that type [33ma[0m+  has kind [33mType[0m+while inferring the kind of [33mArray a[0m+while checking that expression [33mbar       [0m+                               [33m  where   [0m+                               [33m  bar = [][0m+  has type [33mArray a0[0m+in value declaration [33mfoo[0m++where [33ma0[0m is a rigid type variable+        bound at (line 7, column 7 - line 7, column 10)++See https://github.com/purescript/documentation/blob/master/errors/UndefinedTypeVariable.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2567.out view
@@ -0,0 +1,18 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2567.purs:7:8 - 7:67 (line 7, column 8 - line 7, column 67)++  A custom type error occurred while solving type class constraints:++    This constraint should be checked+++while checking that type [33mFail (Text "This constraint should be checked") => Int[0m+  is at least as general as type [33mInt[0m+while checking that expression [33m0[0m+  has type [33mInt[0m+in value declaration [33mfoo[0m++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2601.out view
@@ -0,0 +1,21 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2601.purs:6:12 - 6:15 (line 6, column 12 - line 6, column 15)++  Could not match kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m+  with kind+  [33m              [0m+  [33m  Type -> Type[0m+  [33m              [0m++while checking that type [33mInt[0m+  has kind [33mType -> Type[0m+while inferring the kind of [33mSyn Int[0m+in value declaration [33mval[0m++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2616.out view
@@ -0,0 +1,25 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/2616.purs:9:1 - 9:38 (line 9, column 1 - line 9, column 38)++  No type class instance was found for+  [33m                           [0m+  [33m  Prim.RowList.RowToList r1[0m+  [33m                         t2[0m+  [33m                           [0m+  The instance head contains unknown type variables. Consider adding a type annotation.++while applying a function [33mcompare[0m+  of type [33mOrd t0 => t0 -> t0 -> Ordering[0m+  to argument [33m$l6[0m+while inferring the type of [33mcompare $l6[0m+in value declaration [33mordFoo[0m++where [33mr1[0m is a rigid type variable+        bound at (line 0, column 0 - line 0, column 0)+      [33mt0[0m is an unknown type+      [33mt2[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2806.out view
@@ -0,0 +1,28 @@+Error found:+in module [33mX[0m+at tests/purs/failing/2806.purs:6:1 - 6:29 (line 6, column 1 - line 6, column 29)++  A case expression could not be determined to cover all inputs.+  The following additional cases are required to cover all inputs:++    [33m_[0m++  Alternatively, add a Partial constraint to the type of the enclosing value.++while applying a function [33m$__unused[0m+  of type [33mPartial => t1 -> t1[0m+  to argument [33mcase e of          [0m+              [33m  e | L x <- e -> x[0m+while checking that expression [33m$__unused (case e of          [0m+                               [33m             e | L x <- e -> x[0m+                               [33m          )                   [0m+  has type [33ma0[0m+in value declaration [33mg[0m++where [33ma0[0m is a rigid type variable+        bound at (line 0, column 0 - line 0, column 0)+      [33mt1[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2874-forall.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2874-forall.purs:5:24 - 5:30 (line 5, column 24 - line 5, column 30)++  Unable to parse module:+  Unexpected token 'forall'+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2874-forall2.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2874-forall2.purs:5:12 - 5:18 (line 5, column 12 - line 5, column 18)++  Unable to parse module:+  Unexpected token 'forall'+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2874-wildcard.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2874-wildcard.purs:10:25 - 10:26 (line 10, column 25 - line 10, column 26)++  Unable to parse module:+  Unexpected wildcard in type; type wildcards are only allowed in value annotations+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/2947.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/2947.purs:10:1 - 10:1 (line 10, column 1 - line 10, column 1)++  Unable to parse module:+  Unexpected or mismatched indentation+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3077.out view
@@ -0,0 +1,25 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/3077.purs:11:24 - 11:30 (line 11, column 24 - line 11, column 30)++  Could not match kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m+  with kind+  [33m        [0m+  [33m  Symbol[0m+  [33m        [0m++while trying to match type [33mSProxy[0m+  with type [33mt0[0m+while checking that expression [33mSProxy[0m+  has type [33mt0 t1[0m+in value declaration [33mwrong[0m++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3077.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith KindsDoNotUnify+module Main where++data TProxy (t :: Type) = TProxy+data SProxy (s :: Symbol) = SProxy++put :: forall proxy a. proxy a -> TProxy a+put _ = TProxy++--wrong :: TProxy "apple"+wrong = put (SProxy :: SProxy "apple")
+ tests/purs/failing/3132.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/3132.purs:2:1 - 18:13 (line 2, column 1 - line 18, column 13)++  An export for [33mclass C3[0m requires the following to also be exported:++    [33mclass C1[0m+    [33mclass C2[0m++++See https://github.com/purescript/documentation/blob/master/errors/TransitiveExportError.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3275-BindingGroupErrorPos.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mBindingGroupErrorPos[0m+at tests/purs/failing/3275-BindingGroupErrorPos.purs:11:17 - 11:23 (line 11, column 17 - line 11, column 23)++  Could not match kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m+  with kind+  [33m            [0m+  [33m  Type -> t3[0m+  [33m            [0m++while checking that type [33mResult[0m+  has kind [33mType -> t0[0m+while inferring the kind of [33mResult String[0m+while inferring the kind of [33mInt -> Result String[0m+in binding group wrong++where [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3275-DataBindingGroupErrorPos.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mDataBindingGroupErrorPos[0m+at tests/purs/failing/3275-DataBindingGroupErrorPos.purs:7:19 - 7:22 (line 7, column 19 - line 7, column 22)++  Could not match kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m+  with kind+  [33m            [0m+  [33m  t10 -> t11[0m+  [33m            [0m++while checking that type [33mBar a[0m+  has kind [33mt0 -> t1[0m+while inferring the kind of [33mBar a a[0m+in data binding group Bar, Foo++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3335-TypeOpAssociativityError.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/3335-TypeOpAssociativityError.purs:6:1 - 6:33 (line 6, column 1 - line 6, column 33)++  Cannot parse an expression that uses multiple instances of the non-associative operator [33mMain.(>>)[0m.+  Use parentheses to resolve this ambiguity.+++See https://github.com/purescript/documentation/blob/master/errors/NonAssociativeError.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3405.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/3405.purs:8:1 - 8:43 (line 8, column 1 - line 8, column 43)++  Cannot derive a type class instance, because the type declaration for [33mSomething[0m could not be found.+++See https://github.com/purescript/documentation/blob/master/errors/CannotFindDerivingType.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3549-a.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/3549-a.purs:6:26 - 6:29 (line 6, column 26 - line 6, column 29)++  Unknown type [33mTyp[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3549.out view
@@ -0,0 +1,25 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/3549.purs:8:78 - 8:79 (line 8, column 78 - line 8, column 79)++  Could not match kind+  [33m              [0m+  [33m  Type -> Type[0m+  [33m              [0m+  with kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m++while checking that type [33mf[0m+  has kind [33mType -> Type[0m+while inferring the kind of [33mFunctor f[0m+while inferring the kind of [33mFunctor f => (a -> b) -> f a -> f b[0m+while inferring the kind of [33mforall (b :: Type). Functor f => (a -> b) -> f a -> f b[0m+while inferring the kind of [33mforall (a :: Type) (b :: Type). Functor f => (a -> b) -> f a -> f b[0m+while inferring the kind of [33mforall (f :: Type -> Type -> Type) (a :: Type) (b :: Type). Functor f => (a -> b) -> f a -> f b[0m+in value declaration [33mmap'[0m++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/365.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/365.purs:10:1 - 12:8 (line 10, column 1 - line 12, column 8)++  The value of [33mcS[0m is undefined here, so this reference is not allowed.+++See https://github.com/purescript/documentation/blob/master/errors/CycleInDeclaration.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/3689.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/3689.purs:5:5 - 5:10 (line 5, column 5 - line 5, column 10)++  Unable to parse module:+  Unexpected quoted label in record pun, perhaps due to a missing ':'+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/438.out view
@@ -0,0 +1,25 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/438.purs:15:11 - 15:25 (line 15, column 11 - line 15, column 25)++  Type class instance for+  [33m                                [0m+  [33m  Data.Eq.Eq (Array (Fix Array))[0m+  [33m                                [0m+  is possibly infinite.++while solving type class constraint+[33m                        [0m+[33m  Data.Eq.Eq (Fix Array)[0m+[33m                        [0m+while applying a function [33meq[0m+  of type [33mEq t0 => t0 -> t0 -> Boolean[0m+  to argument [33mIn [][0m+while inferring the type of [33meq (In [])[0m+in value declaration [33mexample[0m++where [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/PossiblyInfiniteInstance.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/881.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/881.purs:10:1 - 13:12 (line 10, column 1 - line 13, column 12)++  Multiple value declarations exist for [33mfoo[0m.++in type class instance+[33m            [0m+[33m  Main.Foo X[0m+[33m            [0m++See https://github.com/purescript/documentation/blob/master/errors/DuplicateValueDeclaration.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/AnonArgument1.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/AnonArgument1.purs:5:1 - 5:9 (line 5, column 1 - line 5, column 9)++  An anonymous function argument appears in an invalid context.+++See https://github.com/purescript/documentation/blob/master/errors/IncorrectAnonymousArgument.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/AnonArgument2.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/AnonArgument2.purs:7:1 - 7:17 (line 7, column 1 - line 7, column 17)++  An anonymous function argument appears in an invalid context.+++See https://github.com/purescript/documentation/blob/master/errors/IncorrectAnonymousArgument.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/AnonArgument3.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/AnonArgument3.purs:5:1 - 5:13 (line 5, column 1 - line 5, column 13)++  An anonymous function argument appears in an invalid context.+++See https://github.com/purescript/documentation/blob/master/errors/IncorrectAnonymousArgument.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ApostropheModuleName.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/ApostropheModuleName.purs:3:8 - 3:18 (line 3, column 8 - line 3, column 18)++  Unable to parse module:+  Invalid module name; underscores and primes are not allowed in module names+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ArgLengthMismatch.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mArgLengthMismatch[0m+at tests/purs/failing/ArgLengthMismatch.purs:6:1 - 6:13 (line 6, column 1 - line 6, column 13)++  Argument list lengths differ in declaration [33mf[0m+++See https://github.com/purescript/documentation/blob/master/errors/ArgListLengthsDiffer.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ArrayType.out view
@@ -0,0 +1,22 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ArrayType.purs:10:7 - 10:8 (line 10, column 7 - line 10, column 8)++  Could not match type+  [33m     [0m+  [33m  Int[0m+  [33m     [0m+  with type+  [33m        [0m+  [33m  Number[0m+  [33m        [0m++while checking that type [33mInt[0m+  is at least as general as type [33mNumber[0m+while checking that expression [33mx[0m+  has type [33mNumber[0m+in value declaration [33mfoo[0m++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/Arrays.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/Arrays.purs:6:26 - 6:27 (line 6, column 26 - line 6, column 27)++  Could not match type+  [33m     [0m+  [33m  Int[0m+  [33m     [0m+  with type+  [33m          [0m+  [33m  Array t0[0m+  [33m          [0m++while checking that type [33mInt[0m+  is at least as general as type [33mArray t0[0m+while checking that expression [33m0[0m+  has type [33mArray t0[0m+in value declaration [33mtest[0m++where [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/AtPatternPrecedence.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/AtPatternPrecedence.purs:11:1 - 11:15 (line 11, column 1 - line 11, column 15)++  Argument list lengths differ in declaration [33moops[0m+++See https://github.com/purescript/documentation/blob/master/errors/ArgListLengthsDiffer.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/BindInDo-2.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/BindInDo-2.purs:7:7 - 7:16 (line 7, column 7 - line 7, column 16)++  The name [33mbind[0m cannot be brought into scope in a do notation block, since do notation uses the same name.+++See https://github.com/purescript/documentation/blob/master/errors/CannotUseBindWithDo.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/BindInDo.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/BindInDo.purs:7:3 - 7:18 (line 7, column 3 - line 7, column 18)++  The name [33mbind[0m cannot be brought into scope in a do notation block, since do notation uses the same name.+++See https://github.com/purescript/documentation/blob/master/errors/CannotUseBindWithDo.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CannotDeriveNewtypeForData.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/CannotDeriveNewtypeForData.purs:6:1 - 6:24 (line 6, column 1 - line 6, column 24)++  Cannot derive an instance of the [33mNewtype[0m class for non-newtype [33mTest[0m.+++See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveNewtypeForData.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CaseBinderLengthsDiffer.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CaseBinderLengthsDiffer.purs:5:3 - 5:10 (line 5, column 3 - line 5, column 10)++  Binder list length differs in case alternative:++    1, 2, 3++  Expecting 2 binders.+++See https://github.com/purescript/documentation/blob/master/errors/CaseBinderLengthDiffers.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.out view
@@ -0,0 +1,16 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.purs:11:9 - 11:17 (line 11, column 9 - line 11, column 17)++  Data constructor [33mMain.Person[0m was given 1 arguments in a case expression, but expected 2 arguments.+  This problem can be fixed by giving [33mMain.Person[0m 2 arguments.++while inferring the type of [33m\p ->                                   [0m+                            [33m  case p of                             [0m+                            [33m    (Two (Person n) (Person n2 a2)) -> n[0m+                            [33m    _ -> "Unknown"                      [0m+in value declaration [33mgetName[0m++See https://github.com/purescript/documentation/blob/master/errors/IncorrectConstructorArity.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleClosedRowsDoNotUnify.out view
@@ -0,0 +1,39 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleClosedRowsDoNotUnify.purs:7:12 - 7:18 (line 7, column 12 - line 7, column 18)++  Could not match type+  [33m            [0m+  [33m  ( x :: Int[0m+  [33m  ...       [0m+  [33m  )         [0m+  [33m            [0m+  with type+  [33m               [0m+  [33m  ( y :: String[0m+  [33m  ...          [0m+  [33m  )            [0m+  [33m               [0m++while solving type class constraint+[33m                                     [0m+[33m  Prim.Coerce.Coercible { x :: Int   [0m+[33m                        }            [0m+[33m                        { y :: String[0m+[33m                        }            [0m+[33m                                     [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33m{ x :: Int      [0m+                                 [33m}               [0m+                                 [33m-> { y :: String[0m+                                 [33m   }            [0m+while checking that expression [33mcoerce[0m+  has type [33m{ x :: Int      [0m+           [33m}               [0m+           [33m-> { y :: String[0m+           [33m   }            [0m+in value declaration [33mrecToRec[0m++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleClosedRowsDoNotUnify.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++recToRec :: { x :: Int } -> { y :: String }+recToRec = coerce
+ tests/purs/failing/CoercibleConstrained1.out view
@@ -0,0 +1,29 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleConstrained1.purs:11:28 - 11:34 (line 11, column 28 - line 11, column 34)++  No type class instance was found for+  [33m                          [0m+  [33m  Prim.Coerce.Coercible a0[0m+  [33m                        b1[0m+  [33m                          [0m++while solving type class constraint+[33m                                        [0m+[33m  Prim.Coerce.Coercible (Constrained a0)[0m+[33m                        (Constrained b1)[0m+[33m                                        [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mConstrained a0 -> Constrained b1[0m+while checking that expression [33mcoerce[0m+  has type [33mConstrained a0 -> Constrained b1[0m+in value declaration [33mconstrainedToConstrained[0m++where [33ma0[0m is a rigid type variable+        bound at (line 11, column 28 - line 11, column 34)+      [33mb1[0m is a rigid type variable+        bound at (line 11, column 28 - line 11, column 34)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleConstrained1.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++class Nullary++data Constrained a = Constrained (Nullary => a)++constrainedToConstrained :: forall a b. Constrained a -> Constrained b+constrainedToConstrained = coerce
+ tests/purs/failing/CoercibleConstrained2.out view
@@ -0,0 +1,32 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleConstrained2.purs:11:28 - 11:34 (line 11, column 28 - line 11, column 34)++  Could not match type+  [33m    [0m+  [33m  a0[0m+  [33m    [0m+  with type+  [33m    [0m+  [33m  b1[0m+  [33m    [0m++while solving type class constraint+[33m                                        [0m+[33m  Prim.Coerce.Coercible (Constrained a0)[0m+[33m                        (Constrained b1)[0m+[33m                                        [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mConstrained a0 -> Constrained b1[0m+while checking that expression [33mcoerce[0m+  has type [33mConstrained a0 -> Constrained b1[0m+in value declaration [33mconstrainedToConstrained[0m++where [33ma0[0m is a rigid type variable+        bound at (line 11, column 28 - line 11, column 34)+      [33mb1[0m is a rigid type variable+        bound at (line 11, column 28 - line 11, column 34)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleConstrained2.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++class Unary a++data Constrained a = Constrained (Unary a => a)++constrainedToConstrained :: forall a b. Constrained a -> Constrained b+constrainedToConstrained = coerce
+ tests/purs/failing/CoercibleConstrained3.out view
@@ -0,0 +1,30 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleConstrained3.purs:13:28 - 13:34 (line 13, column 28 - line 13, column 34)++  Could not match type+  [33m    [0m+  [33m  a0[0m+  [33m    [0m+  with type+  [33m      [0m+  [33m  N a0[0m+  [33m      [0m++while solving type class constraint+[33m                                            [0m+[33m  Prim.Coerce.Coercible (Constrained a0)    [0m+[33m                        (Constrained (N a0))[0m+[33m                                            [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mConstrained a0 -> Constrained (N a0)[0m+while checking that expression [33mcoerce[0m+  has type [33mConstrained a0 -> Constrained (N a0)[0m+in value declaration [33mconstrainedToConstrained[0m++where [33ma0[0m is a rigid type variable+        bound at (line 13, column 28 - line 13, column 34)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleConstrained3.purs view
@@ -0,0 +1,13 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++class Unary a++data Constrained a = Constrained (Unary a => a)++newtype N a = N a++constrainedToConstrained :: forall a. Constrained a -> Constrained (N a)+constrainedToConstrained = coerce
+ tests/purs/failing/CoercibleForeign.out view
@@ -0,0 +1,32 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleForeign.purs:11:20 - 11:26 (line 11, column 20 - line 11, column 26)++  Could not match type+  [33m    [0m+  [33m  a0[0m+  [33m    [0m+  with type+  [33m       [0m+  [33m  Id a0[0m+  [33m       [0m++while solving type class constraint+[33m                                                 [0m+[33m  Prim.Coerce.Coercible (Foreign a0 b1)          [0m+[33m                        (Foreign (Id a0) (Id b1))[0m+[33m                                                 [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mForeign a0 b1 -> Foreign (Id a0) (Id b1)[0m+while checking that expression [33mcoerce[0m+  has type [33mForeign a0 b1 -> Foreign (Id a0) (Id b1)[0m+in value declaration [33mforeignToForeign[0m++where [33ma0[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)+      [33mb1[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleForeign.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++foreign import data Foreign :: Type -> Type -> Type++newtype Id a = Id a++foreignToForeign :: forall a b. Foreign a b -> Foreign (Id a) (Id b)+foreignToForeign = coerce
+ tests/purs/failing/CoercibleForeign2.out view
@@ -0,0 +1,36 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleForeign2.purs:9:20 - 9:26 (line 9, column 20 - line 9, column 26)++  Could not match type+  [33m    [0m+  [33m  c2[0m+  [33m    [0m+  with type+  [33m    [0m+  [33m  d3[0m+  [33m    [0m++while solving type class constraint+[33m                                          [0m+[33m  Prim.Coerce.Coercible (Foreign a0 b1 c2)[0m+[33m                        (Foreign a0 b1 d3)[0m+[33m                                          [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mForeign a0 b1 c2 -> Foreign a0 b1 d3[0m+while checking that expression [33mcoerce[0m+  has type [33mForeign a0 b1 c2 -> Foreign a0 b1 d3[0m+in value declaration [33mforeignToForeign[0m++where [33ma0[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)+      [33mb1[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)+      [33mc2[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)+      [33md3[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleForeign2.purs view
@@ -0,0 +1,9 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++foreign import data Foreign :: Type -> Type -> Type -> Type++foreignToForeign :: forall a b c d. Foreign a b c -> Foreign a b d+foreignToForeign = coerce
+ tests/purs/failing/CoercibleForeign3.out view
@@ -0,0 +1,36 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleForeign3.purs:9:20 - 9:26 (line 9, column 20 - line 9, column 26)++  Could not match type+  [33m    [0m+  [33m  b2[0m+  [33m    [0m+  with type+  [33m    [0m+  [33m  c3[0m+  [33m    [0m++while solving type class constraint+[33m                                           [0m+[33m  Prim.Coerce.Coercible (Foreign @k0 a1 b2)[0m+[33m                        (Foreign @k0 a1 c3)[0m+[33m                                           [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mForeign @k0 a1 b2 -> Foreign @k0 a1 c3[0m+while checking that expression [33mcoerce[0m+  has type [33mForeign @k0 a1 b2 -> Foreign @k0 a1 c3[0m+in value declaration [33mforeignToForeign[0m++where [33mk0[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)+      [33ma1[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)+      [33mb2[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)+      [33mc3[0m is a rigid type variable+        bound at (line 9, column 20 - line 9, column 26)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleForeign3.purs view
@@ -0,0 +1,9 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++foreign import data Foreign :: ∀ k. k -> k -> Type++foreignToForeign :: ∀ k (a :: k) (b :: k) (c :: k). Foreign a b -> Foreign a c+foreignToForeign = coerce
+ tests/purs/failing/CoercibleHigherKindedData.out view
@@ -0,0 +1,33 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleHigherKindedData.purs:13:17 - 13:23 (line 13, column 17 - line 13, column 23)++  No type class instance was found for+  [33m                                      [0m+  [33m  Prim.Coerce.Coercible (Unary t5)    [0m+  [33m                        (Binary a3 t5)[0m+  [33m                                      [0m+  The instance head contains unknown type variables. Consider adding a type annotation.++while solving type class constraint+[33m                                                                 [0m+[33m  Prim.Coerce.Coercible (Proxy @(t0 -> Type) (Unary @t0))        [0m+[33m                        (Proxy @(t1 -> Type) (Binary @t2 @t1 a3))[0m+[33m                                                                 [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mProxy @(t0 -> Type) (Unary @t0) -> Proxy @(t1 -> Type) (... @t1 a3)[0m+while checking that expression [33mcoerce[0m+  has type [33mProxy @(t0 -> Type) (Unary @t0) -> Proxy @(t1 -> Type) (... @t1 a3)[0m+in value declaration [33munaryToBinary[0m++where [33ma3[0m is a rigid type variable+        bound at (line 13, column 17 - line 13, column 23)+      [33mt0[0m is an unknown type+      [33mt2[0m is an unknown type+      [33mt1[0m is an unknown type+      [33mt4[0m is an unknown type+      [33mt5[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleHigherKindedData.purs view
@@ -0,0 +1,13 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++data Unary a+data Binary a b++data Proxy a = Proxy+type role Proxy representational++unaryToBinary :: forall a. Proxy Unary -> Proxy (Binary a)+unaryToBinary = coerce
+ tests/purs/failing/CoercibleHigherKindedNewtypes.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleHigherKindedNewtypes.purs:13:8 - 13:14 (line 13, column 8 - line 13, column 14)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible Int   [0m+  [33m                        String[0m+  [33m                              [0m++while solving type class constraint+[33m                                                      [0m+[33m  Prim.Coerce.Coercible (Ap @Type @Type N1 Int String)[0m+[33m                        (Ap @Type @Type N2 Int String)[0m+[33m                                                      [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mAp @Type @Type N1 Int String -> Ap @Type @Type N2 Int String[0m+while checking that expression [33mcoerce[0m+  has type [33mAp @Type @Type N1 Int String -> Ap @Type @Type N2 Int String[0m+in value declaration [33mswap[0m++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleHigherKindedNewtypes.purs view
@@ -0,0 +1,13 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++newtype Ap f a b = Ap (f a b)++data Tuple a b = Tuple a b+newtype N1 a b = N1 (Tuple a b)+newtype N2 b a = N2 (Tuple a b)++swap :: Ap N1 Int String -> Ap N2 Int String+swap = coerce
+ tests/purs/failing/CoercibleKindMismatch.out view
@@ -0,0 +1,31 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleKindMismatch.purs:14:39 - 14:45 (line 14, column 39 - line 14, column 45)++  Could not match kind+  [33m      [0m+  [33m  Type[0m+  [33m      [0m+  with kind+  [33m             [0m+  [33m  t29 -> Type[0m+  [33m             [0m++while solving type class constraint+[33m                                                                    [0m+[33m  Prim.Coerce.Coercible (Proxy @(t0 -> Type) (Unary @t0))           [0m+[33m                        (Proxy @(t1 -> t2 -> Type) (Binary @t1 @t2))[0m+[33m                                                                    [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mProxy @(t0 -> Type) (Unary @t0) -> Proxy @(t1 -> ...) (Binary @t1 @t2)[0m+while checking that expression [33mcoerce[0m+  has type [33mProxy @(t0 -> Type) (Unary @t0) -> Proxy @(t1 -> ...) (Binary @t1 @t2)[0m+in value declaration [33munaryToBinary[0m++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type+      [33mt2[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleKindMismatch.purs view
@@ -0,0 +1,15 @@+-- @shouldFailWith KindsDoNotUnify+module Main where++import Safe.Coerce (coerce)++data Unary a+data Binary a b++data Proxy :: forall k. k -> Type+data Proxy a = Proxy++type role Proxy representational++unaryToBinary :: Proxy Unary -> Proxy Binary+unaryToBinary = coerce
+ tests/purs/failing/CoercibleNominal.out view
@@ -0,0 +1,34 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleNominal.purs:11:20 - 11:26 (line 11, column 20 - line 11, column 26)++  Could not match type+  [33m    [0m+  [33m  a0[0m+  [33m    [0m+  with type+  [33m    [0m+  [33m  b2[0m+  [33m    [0m++while solving type class constraint+[33m                                       [0m+[33m  Prim.Coerce.Coercible (Nominal a0 c1)[0m+[33m                        (Nominal b2 c1)[0m+[33m                                       [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mNominal a0 c1 -> Nominal b2 c1[0m+while checking that expression [33mcoerce[0m+  has type [33mNominal a0 c1 -> Nominal b2 c1[0m+in value declaration [33mnominalToNominal[0m++where [33ma0[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)+      [33mb2[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)+      [33mc1[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleNominal.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++data Nominal a (b :: Type) = Nominal a++type role Nominal nominal phantom++nominalToNominal :: forall a b c. Nominal a c -> Nominal b c+nominalToNominal = coerce
+ tests/purs/failing/CoercibleNominalTypeApp.out view
@@ -0,0 +1,27 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleNominalTypeApp.purs:13:8 - 13:14 (line 13, column 8 - line 13, column 14)++  Could not match type+  [33m     [0m+  [33m  Int[0m+  [33m     [0m+  with type+  [33m        [0m+  [33m  String[0m+  [33m        [0m++while solving type class constraint+[33m                                              [0m+[33m  Prim.Coerce.Coercible (G @Type Maybe Int)   [0m+[33m                        (G @Type Maybe String)[0m+[33m                                              [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mG @Type Maybe Int -> G @Type Maybe String[0m+while checking that expression [33mcoerce[0m+  has type [33mG @Type Maybe Int -> G @Type Maybe String[0m+in value declaration [33mgToG[0m++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleNominalTypeApp.purs view
@@ -0,0 +1,13 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++data Phantom a = Phantom++data Maybe a = Nothing | Just a++data G a b = G (a (Phantom b))++gToG :: G Maybe Int -> G Maybe String+gToG = coerce
+ tests/purs/failing/CoercibleNominalWrapped.out view
@@ -0,0 +1,32 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleNominalWrapped.purs:15:14 - 15:20 (line 15, column 14 - line 15, column 20)++  Could not match type+  [33m    [0m+  [33m  a0[0m+  [33m    [0m+  with type+  [33m       [0m+  [33m  Id a0[0m+  [33m       [0m++while solving type class constraint+[33m                                         [0m+[33m  Prim.Coerce.Coercible (Wrap a0 b1)     [0m+[33m                        (Wrap (Id a0) b1)[0m+[33m                                         [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mWrap a0 b1 -> Wrap (Id a0) b1[0m+while checking that expression [33mcoerce[0m+  has type [33mWrap a0 b1 -> Wrap (Id a0) b1[0m+in value declaration [33mwrapToWrap[0m++where [33ma0[0m is a rigid type variable+        bound at (line 15, column 14 - line 15, column 20)+      [33mb1[0m is a rigid type variable+        bound at (line 15, column 14 - line 15, column 20)++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleNominalWrapped.purs view
@@ -0,0 +1,15 @@+-- @shouldFailWith TypesDoNotUnify+module Main where++import Safe.Coerce (coerce)++data Nominal a (b :: Type) = Nominal a++type role Nominal nominal phantom++newtype Id a = Id a++data Wrap a b = Wrap (Nominal a b)++wrapToWrap :: forall a b. Wrap a b -> Wrap (Id a) b+wrapToWrap = coerce
+ tests/purs/failing/CoercibleNonCanonical1.out view
@@ -0,0 +1,27 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleNonCanonical1.purs:11:27 - 11:33 (line 11, column 27 - line 11, column 33)++  No type class instance was found for+  [33m                                  [0m+  [33m  Prim.Coerce.Coercible a0        [0m+  [33m                        (D (N a0))[0m+  [33m                                  [0m++while solving type class constraint+[33m                                    [0m+[33m  Prim.Coerce.Coercible a0          [0m+[33m                        (N @Type a0)[0m+[33m                                    [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33ma0 -> N @Type a0[0m+while checking that expression [33mcoerce[0m+  has type [33ma0 -> N @Type a0[0m+in value declaration [33mnonCanonicalSameTyVarEq[0m++where [33ma0[0m is a rigid type variable+        bound at (line 11, column 27 - line 11, column 33)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleNonCanonical1.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Prim.Coerce (class Coercible)+import Safe.Coerce (coerce)++data D a = D a+newtype N a = N (D (N a))++nonCanonicalSameTyVarEq :: forall a. Coercible a (D a) => a -> N a+nonCanonicalSameTyVarEq = coerce
+ tests/purs/failing/CoercibleNonCanonical2.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleNonCanonical2.purs:10:27 - 10:33 (line 10, column 27 - line 10, column 33)++  No type class instance was found for+  [33m                          [0m+  [33m  Prim.Coerce.Coercible a0[0m+  [33m                        b1[0m+  [33m                          [0m++while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33ma0 -> b1[0m+while checking that expression [33mcoerce[0m+  has type [33ma0 -> b1[0m+in value declaration [33mnonCanonicalDiffTyVarEq[0m++where [33ma0[0m is a rigid type variable+        bound at (line 10, column 27 - line 10, column 33)+      [33mb1[0m is a rigid type variable+        bound at (line 10, column 27 - line 10, column 33)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleNonCanonical2.purs view
@@ -0,0 +1,10 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Prim.Coerce (class Coercible)+import Safe.Coerce (coerce)++data D a = D a++nonCanonicalDiffTyVarEq :: forall a b. Coercible b (D b) => a -> b+nonCanonicalDiffTyVarEq = coerce
+ tests/purs/failing/CoercibleOpenRowsDoNotUnify.out view
@@ -0,0 +1,43 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleOpenRowsDoNotUnify.purs:7:12 - 7:18 (line 7, column 12 - line 7, column 18)++  No type class instance was found for+  [33m                          [0m+  [33m  Prim.Coerce.Coercible r0[0m+  [33m                        s1[0m+  [33m                          [0m++while solving type class constraint+[33m                                  [0m+[33m  Prim.Coerce.Coercible { x :: Int[0m+[33m                        | r0      [0m+[33m                        }         [0m+[33m                        { x :: Int[0m+[33m                        | s1      [0m+[33m                        }         [0m+[33m                                  [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33m{ x :: Int   [0m+                                 [33m| r0         [0m+                                 [33m}            [0m+                                 [33m-> { x :: Int[0m+                                 [33m   | s1      [0m+                                 [33m   }         [0m+while checking that expression [33mcoerce[0m+  has type [33m{ x :: Int   [0m+           [33m| r0         [0m+           [33m}            [0m+           [33m-> { x :: Int[0m+           [33m   | s1      [0m+           [33m   }         [0m+in value declaration [33mrecToRec[0m++where [33mr0[0m is a rigid type variable+        bound at (line 7, column 12 - line 7, column 18)+      [33ms1[0m is a rigid type variable+        bound at (line 7, column 12 - line 7, column 18)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleOpenRowsDoNotUnify.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++recToRec :: forall r s. { x :: Int | r } -> { x :: Int | s }+recToRec = coerce
+ tests/purs/failing/CoercibleRepresentational.out view
@@ -0,0 +1,31 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational.purs:11:20 - 11:26 (line 11, column 20 - line 11, column 26)++  No type class instance was found for+  [33m                          [0m+  [33m  Prim.Coerce.Coercible a1[0m+  [33m                        b3[0m+  [33m                          [0m++while solving type class constraint+[33m                                        [0m+[33m  Prim.Coerce.Coercible (Phantom @t0 a1)[0m+[33m                        (Phantom @t2 b3)[0m+[33m                                        [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mPhantom @t0 a1 -> Phantom @t2 b3[0m+while checking that expression [33mcoerce[0m+  has type [33mPhantom @t0 a1 -> Phantom @t2 b3[0m+in value declaration [33mphantomToPhantom[0m++where [33ma1[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)+      [33mb3[0m is a rigid type variable+        bound at (line 11, column 20 - line 11, column 26)+      [33mt0[0m is an unknown type+      [33mt2[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++data Phantom a = Phantom++type role Phantom representational++phantomToPhantom :: forall a b. Phantom a -> Phantom b+phantomToPhantom = coerce
+ tests/purs/failing/CoercibleRepresentational2.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational2.purs:9:14 - 9:20 (line 9, column 14 - line 9, column 20)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible Int   [0m+  [33m                        String[0m+  [33m                              [0m++while solving type class constraint+[33m                                     [0m+[33m  Prim.Coerce.Coercible (Arr1 Int)   [0m+[33m                        (Arr1 String)[0m+[33m                                     [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mArr1 Int -> Arr1 String[0m+while checking that expression [33mcoerce[0m+  has type [33mArr1 Int -> Arr1 String[0m+in value declaration [33marr1ToArr1[0m++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational2.purs view
@@ -0,0 +1,9 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++data Arr1 a = Arr1 (Array a)++arr1ToArr1 :: Arr1 Int -> Arr1 String+arr1ToArr1 = coerce
+ tests/purs/failing/CoercibleRepresentational3.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational3.purs:9:14 - 9:20 (line 9, column 14 - line 9, column 20)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible Int   [0m+  [33m                        String[0m+  [33m                              [0m++while solving type class constraint+[33m                                     [0m+[33m  Prim.Coerce.Coercible (Rec1 Int)   [0m+[33m                        (Rec1 String)[0m+[33m                                     [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mRec1 Int -> Rec1 String[0m+while checking that expression [33mcoerce[0m+  has type [33mRec1 Int -> Rec1 String[0m+in value declaration [33marr1ToArr1[0m++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational3.purs view
@@ -0,0 +1,9 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++data Rec1 a = Rec1 { f :: a }++arr1ToArr1 :: Rec1 Int -> Rec1 String+arr1ToArr1 = coerce
+ tests/purs/failing/CoercibleRepresentational4.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational4.purs:11:38 - 11:44 (line 11, column 38 - line 11, column 44)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible Int   [0m+  [33m                        String[0m+  [33m                              [0m++while solving type class constraint+[33m                                                 [0m+[33m  Prim.Coerce.Coercible (Representational Int)   [0m+[33m                        (Representational String)[0m+[33m                                                 [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mRepresentational Int -> Representational String[0m+while checking that expression [33mcoerce[0m+  has type [33mRepresentational Int -> Representational String[0m+in value declaration [33mrepresentationalToRepresentational[0m++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational4.purs view
@@ -0,0 +1,11 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++data F a = F a+type Synonym a = F a+data Representational a = Representational (Synonym a)++representationalToRepresentational :: Representational Int -> Representational String+representationalToRepresentational = coerce
+ tests/purs/failing/CoercibleRepresentational5.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational5.purs:15:38 - 15:44 (line 15, column 38 - line 15, column 44)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible Int   [0m+  [33m                        String[0m+  [33m                              [0m++while solving type class constraint+[33m                                                                   [0m+[33m  Prim.Coerce.Coercible (MutuallyRecursiveRepresentational2 Int)   [0m+[33m                        (MutuallyRecursiveRepresentational2 String)[0m+[33m                                                                   [0m+while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mMutuallyRecursiveRepresentational2 Int -> MutuallyRecursiveRepresentational2 String[0m+while checking that expression [33mcoerce[0m+  has type [33mMutuallyRecursiveRepresentational2 Int -> MutuallyRecursiveRepresentational2 String[0m+in value declaration [33mrepresentationalToRepresentational[0m++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational5.purs view
@@ -0,0 +1,15 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++data MutuallyRecursiveRepresentational1 a+  = MutuallyRecursiveRepresentational1 a (MutuallyRecursiveRepresentational2 a)++type MutuallyRecursiveRepresentational1Synonym a = MutuallyRecursiveRepresentational1 a++data MutuallyRecursiveRepresentational2 a+  = MutuallyRecursiveRepresentational2 (MutuallyRecursiveRepresentational1Synonym a)++representationalToRepresentational :: MutuallyRecursiveRepresentational2 Int -> MutuallyRecursiveRepresentational2 String+representationalToRepresentational = coerce
+ tests/purs/failing/CoercibleRepresentational6.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational6.purs:8:10 - 8:16 (line 8, column 10 - line 8, column 16)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible (N a0)[0m+  [33m                        a0    [0m+  [33m                              [0m++  Solving this instance requires the newtype constructor [33mN[0m to be in scope.++while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mN a0 -> a0[0m+while checking that expression [33mcoerce[0m+  has type [33mN a0 -> a0[0m+in value declaration [33munwrap[0m++where [33ma0[0m is a rigid type variable+        bound at (line 8, column 10 - line 8, column 16)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational6.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)+import N (N(..))++unwrap :: forall a. N a -> a+unwrap = coerce
+ tests/purs/failing/CoercibleRepresentational6/N.purs view
@@ -0,0 +1,3 @@+module N (N) where++newtype N a = N a
+ tests/purs/failing/CoercibleRepresentational7.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational7.purs:8:10 - 8:16 (line 8, column 10 - line 8, column 16)++  No type class instance was found for+  [33m                              [0m+  [33m  Prim.Coerce.Coercible (N a0)[0m+  [33m                        a0    [0m+  [33m                              [0m++  Solving this instance requires the newtype constructor [33mN[0m to be in scope.++while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33mN a0 -> a0[0m+while checking that expression [33mcoerce[0m+  has type [33mN a0 -> a0[0m+in value declaration [33munwrap[0m++where [33ma0[0m is a rigid type variable+        bound at (line 8, column 10 - line 8, column 16)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational7.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)+import N (N)++unwrap :: forall a. N a -> a+unwrap = coerce
+ tests/purs/failing/CoercibleRepresentational7/N.purs view
@@ -0,0 +1,3 @@+module N (N(..)) where++newtype N a = N a
+ tests/purs/failing/CoercibleRepresentational8.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRepresentational8.purs:9:16 - 9:22 (line 9, column 16 - line 9, column 22)++  No type class instance was found for+  [33m                          [0m+  [33m  Prim.Coerce.Coercible a0[0m+  [33m                        b1[0m+  [33m                          [0m++while checking that type [33mforall (a :: Type) (b :: Type). Coercible @Type a b => a -> b[0m+  is at least as general as type [33ma0 -> b1[0m+while checking that expression [33mcoerce[0m+  has type [33ma0 -> b1[0m+in value declaration [33munsafeCoerce[0m++where [33ma0[0m is a rigid type variable+        bound at (line 9, column 16 - line 9, column 22)+      [33mb1[0m is a rigid type variable+        bound at (line 9, column 16 - line 9, column 22)++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRepresentational8.purs view
@@ -0,0 +1,9 @@+-- @shouldFailWith NoInstanceFound+module Main where++import UnsafeCoerce (UnsafeCoerce)+import Prim.Coerce (class Coercible)+import Safe.Coerce (coerce)++unsafeCoerce :: forall a b. Coercible (UnsafeCoerce a) (UnsafeCoerce b) => a -> b+unsafeCoerce = coerce
+ tests/purs/failing/CoercibleRepresentational8/UnsafeCoerce.purs view
@@ -0,0 +1,7 @@+module UnsafeCoerce where++import Data.Unit (Unit)++newtype UnsafeCoerce a = UnsafeCoerce Unit++type role UnsafeCoerce representational
+ tests/purs/failing/CoercibleRoleMismatch1.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRoleMismatch1.purs:4:1 - 4:29 (line 4, column 1 - line 4, column 29)++  Role mismatch for the type parameter [33ma[0m:++    The annotation says [33mphantom[0m but the role [33mrepresentational[0m is required.+++in role declaration for [33mIdentity[0m+in type constructor [33mIdentity[0m++See https://github.com/purescript/documentation/blob/master/errors/RoleMismatch.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRoleMismatch1.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith RoleMismatch+module Main where++data Identity a = Identity a++type role Identity phantom
+ tests/purs/failing/CoercibleRoleMismatch2.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRoleMismatch2.purs:8:1 - 8:23 (line 8, column 1 - line 8, column 23)++  Role mismatch for the type parameter [33ma[0m:++    The annotation says [33mphantom[0m but the role [33mnominal[0m is required.+++in role declaration for [33mV[0m+in type constructor [33mV[0m++See https://github.com/purescript/documentation/blob/master/errors/RoleMismatch.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRoleMismatch2.purs view
@@ -0,0 +1,10 @@+-- @shouldFailWith RoleMismatch+module Main where++data T r (p :: Type) n = T r n++type role T representational phantom nominal++data V a = V (T a a a)++type role V phantom
+ tests/purs/failing/CoercibleRoleMismatch3.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRoleMismatch3.purs:8:1 - 8:23 (line 8, column 1 - line 8, column 23)++  Role mismatch for the type parameter [33ma[0m:++    The annotation says [33mrepresentational[0m but the role [33mnominal[0m is required.+++in role declaration for [33mU[0m+in type constructor [33mU[0m++See https://github.com/purescript/documentation/blob/master/errors/RoleMismatch.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRoleMismatch3.purs view
@@ -0,0 +1,10 @@+-- @shouldFailWith RoleMismatch+module Main where++data T r (p :: Type) n = T r n++type role T representational phantom nominal++data U a = U (T a a a)++type role U representational
+ tests/purs/failing/CoercibleRoleMismatch4.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRoleMismatch4.purs:4:1 - 4:19 (line 4, column 1 - line 4, column 19)++  Role mismatch for the type parameter [33ma[0m:++    The annotation says [33mrepresentational[0m but the role [33mnominal[0m is required.+++in role declaration for [33mF[0m+in data binding group F, G++See https://github.com/purescript/documentation/blob/master/errors/RoleMismatch.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRoleMismatch4.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith RoleMismatch+module Main where++data F a = F (G a)+type role F representational++data G a = G (F a)+type role G nominal
+ tests/purs/failing/CoercibleRoleMismatch5.out view
@@ -0,0 +1,15 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleRoleMismatch5.purs:4:1 - 4:21 (line 4, column 1 - line 4, column 21)++  Role mismatch for the type parameter [33ma[0m:++    The annotation says [33mphantom[0m but the role [33mrepresentational[0m is required.+++in role declaration for [33mF[0m+in data binding group F, G++See https://github.com/purescript/documentation/blob/master/errors/RoleMismatch.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleRoleMismatch5.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith RoleMismatch+module Main where++data F a = F a (G a)+type role F phantom++data G a = G (F a)
+ tests/purs/failing/CoercibleUnknownRowTail1.out view
@@ -0,0 +1,41 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleUnknownRowTail1.purs:7:9 - 7:24 (line 7, column 9 - line 7, column 24)++  No type class instance was found for+  [33m                          [0m+  [33m  Prim.Coerce.Coercible ()[0m+  [33m                        t0[0m+  [33m                          [0m+  The instance head contains unknown type variables. Consider adding a type annotation.++while solving type class constraint+[33m                                  [0m+[33m  Prim.Coerce.Coercible { a :: Int[0m+[33m                        }         [0m+[33m                        { a :: Int[0m+[33m                        | t0      [0m+[33m                        }         [0m+[33m                                  [0m+while applying a function [33mcoerce[0m+  of type [33mCoercible @Type t1 t2 => t1 -> t2[0m+  to argument [33m{ a: 0[0m+              [33m}     [0m+while checking that expression [33mcoerce { a: 0[0m+                               [33m       }     [0m+  has type [33m{ a :: Int[0m+           [33m| t0      [0m+           [33m}         [0m+while checking type of property accessor [33m(coerce { a: ...[0m+                                         [33m        }       [0m+                                         [33m)               [0m+                                         [33m.a              [0m+in value declaration [33mzero[0m++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type+      [33mt2[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleUnknownRowTail1.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++zero :: Int+zero = (coerce { a: 0 }).a
+ tests/purs/failing/CoercibleUnknownRowTail2.out view
@@ -0,0 +1,46 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/CoercibleUnknownRowTail2.purs:7:9 - 7:30 (line 7, column 9 - line 7, column 30)++  No type class instance was found for+  [33m                                  [0m+  [33m  Prim.Coerce.Coercible ( b :: Int[0m+  [33m                        )         [0m+  [33m                        t0        [0m+  [33m                                  [0m+  The instance head contains unknown type variables. Consider adding a type annotation.++while solving type class constraint+[33m                                  [0m+[33m  Prim.Coerce.Coercible { a :: Int[0m+[33m                        , b :: Int[0m+[33m                        }         [0m+[33m                        { a :: Int[0m+[33m                        | t0      [0m+[33m                        }         [0m+[33m                                  [0m+while applying a function [33mcoerce[0m+  of type [33mCoercible @Type t1 t2 => t1 -> t2[0m+  to argument [33m{ a: 0[0m+              [33m, b: 1[0m+              [33m}     [0m+while checking that expression [33mcoerce { a: 0[0m+                               [33m       , b: 1[0m+                               [33m       }     [0m+  has type [33m{ a :: Int[0m+           [33m| t0      [0m+           [33m}         [0m+while checking type of property accessor [33m(coerce { a: ...[0m+                                         [33m        , b: ...[0m+                                         [33m        }       [0m+                                         [33m)               [0m+                                         [33m.a              [0m+in value declaration [33mzero[0m++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type+      [33mt2[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CoercibleUnknownRowTail2.purs view
@@ -0,0 +1,7 @@+-- @shouldFailWith NoInstanceFound+module Main where++import Safe.Coerce (coerce)++zero :: Int+zero = (coerce { a: 0, b: 1 }).a
+ tests/purs/failing/ConflictingExports.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingExports.purs:3:14 - 3:22 (line 3, column 14 - line 3, column 22)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingImports.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingImports.purs:9:8 - 9:13 (line 9, column 8 - line 9, column 13)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingImports/B.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingImports.purs:9:8 - 9:13 (line 9, column 8 - line 9, column 13)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingImports2.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingImports2.purs:10:8 - 10:13 (line 10, column 8 - line 10, column 13)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingImports2/B.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingImports2.purs:10:8 - 10:13 (line 10, column 8 - line 10, column 13)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingQualifiedImports.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingQualifiedImports.purs:7:7 - 7:14 (line 7, column 7 - line 7, column 14)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingQualifiedImports2.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingQualifiedImports2.purs:2:14 - 2:22 (line 2, column 14 - line 2, column 22)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConflictingQualifiedImports2/B.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConflictingQualifiedImports2.purs:2:14 - 2:22 (line 2, column 14 - line 2, column 22)++  Conflicting definitions are in scope for value [33mthing[0m from the following modules:++    [33mA[0m+    [33mB[0m++++See https://github.com/purescript/documentation/blob/master/errors/ScopeConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConstraintFailure.out view
@@ -0,0 +1,22 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConstraintFailure.purs:12:8 - 12:12 (line 12, column 8 - line 12, column 12)++  No type class instance was found for+  [33m                    [0m+  [33m  Data.Show.Show Foo[0m+  [33m                    [0m++while checking that type [33mforall (a :: Type). Show a => a -> String[0m+  is at least as general as type [33mt0 t1 t2[0m+while checking that expression [33mshow[0m+  has type [33mt0 t1 t2[0m+in value declaration [33mmain[0m++where [33mt0[0m is an unknown type+      [33mt1[0m is an unknown type+      [33mt2[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ConstraintInference.out view
@@ -0,0 +1,19 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ConstraintInference.purs:10:1 - 10:21 (line 10, column 1 - line 10, column 21)++  The inferred type+  [33m                                         [0m+  [33m  forall t8 t11. Show t8 => t11 -> String[0m+  [33m                                         [0m+  has type variables which are not determined by those mentioned in the body of the type:++    [33mt8[0m could not be determined++  Consider adding a type annotation.++in value declaration [33mtest[0m++See https://github.com/purescript/documentation/blob/master/errors/AmbiguousTypeVariables.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CycleInForeignDataKinds.out view
@@ -0,0 +1,13 @@+Error found:+at tests/purs/failing/CycleInForeignDataKinds.purs:5:1 - 5:31 (line 5, column 1 - line 5, column 31)++  A cycle appears in a set of kind declarations:++    {[33mBar[0m, [33mFoo[0m}++  Kind declarations may not refer to themselves in their own signatures.+++See https://github.com/purescript/documentation/blob/master/errors/CycleInKindDeclaration.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CycleInForeignDataKinds.purs view
@@ -0,0 +1,5 @@+-- @shouldFailWith CycleInKindDeclaration+module Main where++foreign import data Foo :: Bar+foreign import data Bar :: Foo
+ tests/purs/failing/CycleInKindDeclaration.out view
@@ -0,0 +1,13 @@+Error found:+at tests/purs/failing/CycleInKindDeclaration.purs:7:1 - 7:24 (line 7, column 1 - line 7, column 24)++  A cycle appears in a set of kind declarations:++    {[33mBar[0m, [33mFoo[0m}++  Kind declarations may not refer to themselves in their own signatures.+++See https://github.com/purescript/documentation/blob/master/errors/CycleInKindDeclaration.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/CycleInKindDeclaration.purs view
@@ -0,0 +1,8 @@+-- @shouldFailWith CycleInKindDeclaration+module Main where++data Foo :: Bar -> Type+data Foo a = Foo++data Bar :: Foo -> Type+data Bar a = Bar
+ tests/purs/failing/DctorOperatorAliasExport.out view
@@ -0,0 +1,13 @@+Error found:+in module [33mData.List[0m+at tests/purs/failing/DctorOperatorAliasExport.purs:2:1 - 6:21 (line 2, column 1 - line 6, column 21)++  An export for [33m(:)[0m requires the following data constructor to also be exported:++    [33mCons[0m++++See https://github.com/purescript/documentation/blob/master/errors/TransitiveDctorExportError.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictClassCtor.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictClassCtor.purs:6:1 - 6:11 (line 6, column 1 - line 6, column 11)++  Declaration for type class [33mFail[0m conflicts with an existing data constructor of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictClassSynonym.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictClassSynonym.purs:8:1 - 8:11 (line 8, column 1 - line 8, column 11)++  Declaration for type class [33mFail[0m conflicts with an existing type of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictClassType.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictClassType.purs:6:1 - 6:10 (line 6, column 1 - line 6, column 10)++  Declaration for type [33mFail[0m conflicts with an existing type class of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictCtorClass.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictCtorClass.purs:6:1 - 6:14 (line 6, column 1 - line 6, column 14)++  Declaration for data constructor [33mFail[0m conflicts with an existing type class of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictCtorCtor.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictCtorCtor.purs:6:1 - 6:15 (line 6, column 1 - line 6, column 15)++  Declaration for data constructor [33mFail[0m conflicts with an existing data constructor of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictDuplicateCtor.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictDuplicateCtor.purs:4:1 - 4:21 (line 4, column 1 - line 4, column 21)++  Declaration for data constructor [33mFail[0m conflicts with an existing data constructor of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictSynonymClass.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictSynonymClass.purs:8:1 - 8:17 (line 8, column 1 - line 8, column 17)++  Declaration for type [33mFail[0m conflicts with an existing type class of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictSynonymType.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictSynonymType.purs:8:1 - 8:17 (line 8, column 1 - line 8, column 17)++  Declaration for type [33mFail[0m conflicts with an existing type of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictTypeClass.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictTypeClass.purs:6:1 - 6:10 (line 6, column 1 - line 6, column 10)++  Declaration for type [33mFail[0m conflicts with an existing type class of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictTypeSynonym.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictTypeSynonym.purs:8:1 - 8:10 (line 8, column 1 - line 8, column 10)++  Declaration for type [33mFail[0m conflicts with an existing type of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DeclConflictTypeType.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DeclConflictTypeType.purs:6:1 - 6:10 (line 6, column 1 - line 6, column 10)++  Declaration for type [33mFail[0m conflicts with an existing type of the same name.+++See https://github.com/purescript/documentation/blob/master/errors/DeclConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DiffKindsSameName.out view
@@ -0,0 +1,21 @@+Error found:+in module [33mDiffKindsSameName[0m+at tests/purs/failing/DiffKindsSameName.purs:13:18 - 13:31 (line 13, column 18 - line 13, column 31)++  Could not match kind+  [33m          [0m+  [33m  DemoKind[0m+  [33m          [0m+  with kind+  [33m          [0m+  [33m  DemoKind[0m+  [33m          [0m++while checking that type [33mDemoData[0m+  has kind [33mDemoKind[0m+while inferring the kind of [33mAProxy DemoData[0m+in value declaration [33mbProxy[0m++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DiffKindsSameName/LibA.out view
@@ -0,0 +1,19 @@+Error found:+in module [33mDiffKindsSameName[0m+at tests/purs/failing/DiffKindsSameName.purs:13:18 - 13:31 (line 13, column 18 - line 13, column 31)++  Could not match kind++    [33mDiffKindsSameName.LibA.DemoKind[0m++  with kind++    [33mDiffKindsSameName.LibB.DemoKind[0m+++while checking the kind of [33mAProxy DemoData[0m+in value declaration [33mbProxy[0m++See https://github.com/purescript/documentation/blob/master/errors/KindsDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/Do.out view
@@ -0,0 +1,20 @@+Error 1 of 2:++  at tests/purs/failing/Do.purs:7:12 - 7:21 (line 7, column 12 - line 7, column 21)++    The last statement in a 'do' block must be an expression, but this block ends with a let binding.+++  See https://github.com/purescript/documentation/blob/master/errors/InvalidDoLet.md for more information,+  or to contribute content related to this error.++Error 2 of 2:++  at tests/purs/failing/Do.purs:9:14 - 9:20 (line 9, column 14 - line 9, column 20)++    The last statement in a 'do' block must be an expression, but this block ends with a binder.+++  See https://github.com/purescript/documentation/blob/master/errors/InvalidDoBind.md for more information,+  or to contribute content related to this error.+
+ tests/purs/failing/DoNotSuggestComposition.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mDoNotSuggestComposition[0m+at tests/purs/failing/DoNotSuggestComposition.purs:13:11 - 13:12 (line 13, column 11 - line 13, column 12)++  Could not match type+  [33m            [0m+  [33m  { y :: Int[0m+  [33m  }         [0m+  [33m            [0m+  with type+  [33m        [0m+  [33m  String[0m+  [33m        [0m++while checking that type [33m{ y :: Int[0m+                         [33m}         [0m+  is at least as general as type [33mString[0m+while checking that expression [33mx[0m+  has type [33mString[0m+in value declaration [33mbar[0m++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DoNotSuggestComposition2.out view
@@ -0,0 +1,24 @@+Error found:+in module [33mDoNotSuggestComposition2[0m+at tests/purs/failing/DoNotSuggestComposition2.purs:7:27 - 7:30 (line 7, column 27 - line 7, column 30)++  Could not match type+  [33m        [0m+  [33m  Record[0m+  [33m        [0m+  with type+  [33m              [0m+  [33m  Function Int[0m+  [33m              [0m++while trying to match type [33m{ y :: Int[0m+                           [33m}         [0m+  with type [33mInt -> t0[0m+while inferring the type of [33mx 2[0m+in value declaration [33mfoo[0m++where [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateDeclarationsInLet.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DuplicateDeclarationsInLet.purs:6:7 - 6:8 (line 6, column 7 - line 6, column 8)++  The same name was used more than once in a let binding.+++See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateInstance.out view
@@ -0,0 +1,17 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DuplicateInstance.purs:6:1 - 6:16 (line 6, column 1 - line 6, column 16)++  Instance [33mi[0m has been defined multiple times:++    tests/purs/failing/DuplicateInstance.purs:6:1 - 6:16 (line 6, column 1 - line 6, column 16)+++in type class instance+[33m         [0m+[33m  Main.Y [0m+[33m         [0m++See https://github.com/purescript/documentation/blob/master/errors/DuplicateInstance.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateModule.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/DuplicateModule.purs:2:1 - 2:16 (line 2, column 1 - line 2, column 16)++  Module [33mM1[0m has been defined multiple times+++See https://github.com/purescript/documentation/blob/master/errors/DuplicateModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateProperties.out view
@@ -0,0 +1,41 @@+Error found:+in module [33mDuplicateProperties[0m+at tests/purs/failing/DuplicateProperties.purs:12:18 - 12:32 (line 12, column 18 - line 12, column 32)++  Could not match type+  [33m             [0m+  [33m  ( y :: Unit[0m+  [33m  ...        [0m+  [33m  )          [0m+  [33m             [0m+  with type+  [33m             [0m+  [33m  ( x :: Unit[0m+  [33m  ...        [0m+  [33m  | t0       [0m+  [33m  )          [0m+  [33m             [0m++while trying to match type [33m             [0m+                           [33m  ( y :: Unit[0m+                           [33m  ...        [0m+                           [33m  )          [0m+                           [33m             [0m+  with type [33m             [0m+            [33m  ( x :: Unit[0m+            [33m  ...        [0m+            [33m  | t0       [0m+            [33m  )          [0m+            [33m             [0m+while checking that expression [33msubtractX hasX[0m+  has type [33mTest         [0m+           [33m  ( x :: Unit[0m+           [33m  | t0       [0m+           [33m  )          [0m+in value declaration [33mbaz[0m++where [33mt0[0m is an unknown type++See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateRoleDeclaration.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DuplicateRoleDeclaration.purs:6:1 - 6:20 (line 6, column 1 - line 6, column 20)++  Duplicate role declaration for [33mA[0m.+++See https://github.com/purescript/documentation/blob/master/errors/DuplicateRoleDeclaration.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateRoleDeclaration.purs view
@@ -0,0 +1,6 @@+-- @shouldFailWith DuplicateRoleDeclaration+module Main where++data A a = A+type role A nominal+type role A phantom
+ tests/purs/failing/DuplicateTypeClass.out view
@@ -0,0 +1,14 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DuplicateTypeClass.purs:4:1 - 4:8 (line 4, column 1 - line 4, column 8)++  Type class [33mC[0m has been defined multiple times:++    tests/purs/failing/DuplicateTypeClass.purs:4:1 - 4:8 (line 4, column 1 - line 4, column 8)+++in type class declaration for [33mC[0m++See https://github.com/purescript/documentation/blob/master/errors/DuplicateTypeClass.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/DuplicateTypeVars.out view
@@ -0,0 +1,11 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DuplicateTypeVars.purs:6:1 - 6:17 (line 6, column 1 - line 6, column 17)++  Type argument [33ma[0m appears more than once.++in type synonym [33mFoo[0m++See https://github.com/purescript/documentation/blob/master/errors/DuplicateTypeArgument.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/EmptyCase.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/EmptyCase.purs:4:25 - 4:26 (line 4, column 25 - line 4, column 26)++  Unable to parse module:+  Unexpected token '\'+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/EmptyClass.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/EmptyClass.purs:6:1 - 6:1 (line 6, column 1 - line 6, column 1)++  Unable to parse module:+  Unexpected or mismatched indentation+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/EmptyDo.out view
@@ -0,0 +1,10 @@+Error found:+at tests/purs/failing/EmptyDo.purs:7:1 - 7:1 (line 7, column 1 - line 7, column 1)++  Unable to parse module:+  Unexpected or mismatched indentation+++See https://github.com/purescript/documentation/blob/master/errors/ErrorParsingModule.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExpectedWildcard.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/ExpectedWildcard.purs:8:1 - 8:51 (line 8, column 1 - line 8, column 51)++  Expected a type wildcard (_) when deriving an instance for [33mTest[0m.+++See https://github.com/purescript/documentation/blob/master/errors/ExpectedWildcard.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictClass.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictClass.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type class [33mB.X[0m conflicts with type class [33mA.X[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictClass/B.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictClass.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type class [33mB.X[0m conflicts with type class [33mA.X[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictClassAndType.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictClassAndType.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type [33mB.X[0m conflicts with type class [33mA.X[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictClassAndType/B.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictClassAndType.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type [33mB.X[0m conflicts with type class [33mA.X[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictCtor.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictCtor.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for data constructor [33mB.X[0m conflicts with data constructor [33mA.X[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictType.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictType.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type [33mB.T[0m conflicts with type [33mA.T[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictType/B.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictType.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type [33mB.T[0m conflicts with type [33mA.T[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictTypeOp.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictTypeOp.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for type operator [33mB.(??)[0m conflicts with type operator [33mA.(??)[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictValue.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictValue.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for value [33mB.x[0m conflicts with value [33mA.x[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictValueOp.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictValueOp.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for operator [33mB.(!!)[0m conflicts with operator [33mA.(!!)[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportConflictValueOp/B.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mC[0m+at tests/purs/failing/ExportConflictValueOp.purs:2:21 - 2:29 (line 2, column 21 - line 2, column 29)++  Export for operator [33mB.(!!)[0m conflicts with operator [33mA.(!!)[0m+++See https://github.com/purescript/documentation/blob/master/errors/ExportConflict.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportExplicit.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mM1[0m+at tests/purs/failing/ExportExplicit.purs:3:18 - 3:19 (line 3, column 18 - line 3, column 19)++  Cannot export unknown value [33mz[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownExport.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportExplicit1.out view
@@ -0,0 +1,22 @@+Error 1 of 2:++  in module [33mMain[0m+  at tests/purs/failing/ExportExplicit1.purs:9:9 - 9:10 (line 9, column 9 - line 9, column 10)++    Unknown data constructor [33mX[0m+++  See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+  or to contribute content related to this error.++Error 2 of 2:++  in module [33mMain[0m+  at tests/purs/failing/ExportExplicit1.purs:10:9 - 10:10 (line 10, column 9 - line 10, column 10)++    Unknown data constructor [33mY[0m+++  See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+  or to contribute content related to this error.+
tests/purs/failing/ExportExplicit1.purs view
@@ -1,12 +1,12 @@ -- @shouldFailWith UnknownName+-- @shouldFailWith UnknownName+-- should fail as X and Y constructors are not exported from M1 module Main where  import M1 import Effect.Console (log)  testX = X---- should fail as Y constructor is not exported from M1 testY = Y  main = log "Done"
tests/purs/failing/ExportExplicit1/M1.purs view
@@ -1,3 +1,3 @@-module M1 (X(X)) where+module M1 (X) where  data X = X | Y
+ tests/purs/failing/ExportExplicit2.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mM1[0m+at tests/purs/failing/ExportExplicit2.purs:3:12 - 3:16 (line 3, column 12 - line 3, column 16)++  Cannot export data constructor [33mY[0m for type [33mX[0m, as it has not been declared.+++See https://github.com/purescript/documentation/blob/master/errors/UnknownExportDataConstructor.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExportExplicit3.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ExportExplicit3.purs:8:9 - 8:12 (line 8, column 9 - line 8, column 12)++  Unknown data constructor [33mM.Z[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExtraRecordField.out view
@@ -0,0 +1,27 @@+Error found:+in module [33mExtraRecordField[0m+at tests/purs/failing/ExtraRecordField.purs:9:13 - 9:54 (line 9, column 13 - line 9, column 54)++  Type of expression contains additional label [33mage[0m.++while checking that expression [33m{ first: "Jane"[0m+                               [33m, last: "Smith"[0m+                               [33m, age: 29      [0m+                               [33m}              [0m+  has type [33m{ first :: String[0m+           [33m, last :: String [0m+           [33m}                [0m+while applying a function [33mfull[0m+  of type [33m{ first :: String[0m+          [33m, last :: String [0m+          [33m}                [0m+          [33m-> String        [0m+  to argument [33m{ first: "Jane"[0m+              [33m, last: "Smith"[0m+              [33m, age: 29      [0m+              [33m}              [0m+in value declaration [33moops[0m++See https://github.com/purescript/documentation/blob/master/errors/AdditionalProperty.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ExtraneousClassMember.out view
@@ -0,0 +1,13 @@+Error found:+at tests/purs/failing/ExtraneousClassMember.purs:11:3 - 11:10 (line 11, column 3 - line 11, column 10)++  [33mb[0m is not a member of type class [33mMain.A[0m++in type class instance+[33m               [0m+[33m  Main.A String[0m+[33m               [0m++See https://github.com/purescript/documentation/blob/master/errors/ExtraneousClassMember.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/Foldable.out view
@@ -0,0 +1,9 @@+Error found:+at tests/purs/failing/Foldable.purs:12:1 - 15:36 (line 12, column 1 - line 15, column 36)++  The value of [33mfoldableL[0m is undefined here, so this reference is not allowed.+++See https://github.com/purescript/documentation/blob/master/errors/CycleInDeclaration.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/Generalization1.out view
@@ -0,0 +1,16 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/Generalization1.purs:6:1 - 6:14 (line 6, column 1 - line 6, column 14)++  Unable to generalize the type of the recursive function [33mfoo[0m.+  The inferred type of [33mfoo[0m was:+  [33m                                                  [0m+  [33m  forall t4. Semigroup t4 => Int -> t4 -> t4 -> t4[0m+  [33m                                                  [0m+  Try adding a type signature.++in binding group foo, bar++See https://github.com/purescript/documentation/blob/master/errors/CannotGeneralizeRecursiveFunction.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/Generalization2.out view
@@ -0,0 +1,16 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/Generalization2.purs:6:1 - 7:45 (line 6, column 1 - line 7, column 45)++  Unable to generalize the type of the recursive function [33mtest[0m.+  The inferred type of [33mtest[0m was:+  [33m                                            [0m+  [33m  forall t7. Semigroup t7 => Int -> t7 -> t7[0m+  [33m                                            [0m+  Try adding a type signature.++in binding group test++See https://github.com/purescript/documentation/blob/master/errors/CannotGeneralizeRecursiveFunction.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ImportExplicit.out view
@@ -0,0 +1,11 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ImportExplicit.purs:4:12 - 4:17 (line 4, column 12 - line 4, column 17)++  Cannot import type [33mX[0m from module [33mM1[0m+  It either does not exist or the module does not export it.+++See https://github.com/purescript/documentation/blob/master/errors/UnknownImport.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ImportExplicit/M1.out view
@@ -0,0 +1,11 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ImportExplicit.purs:4:12 - 4:17 (line 4, column 12 - line 4, column 17)++  Cannot import type [33mX[0m from module [33mM1[0m+  It either does not exist or the module does not export it.+++See https://github.com/purescript/documentation/blob/master/errors/UnknownImport.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ImportExplicit2.out view
@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/ImportExplicit2.purs:4:12 - 4:19 (line 4, column 12 - line 4, column 19)++  Module M1 does not export data constructor [33mZ[0m for type [33mX[0m+++See https://github.com/purescript/documentation/blob/master/errors/UnknownImportDataConstructor.md for more information,+or to contribute content related to this error.+
+ tests/purs/failing/ImportHidingModule.out view

file too large to diff

+ tests/purs/failing/ImportModule.out view

file too large to diff

+ tests/purs/failing/InfiniteKind.out view

file too large to diff

+ tests/purs/failing/InfiniteKind2.out view

file too large to diff

tests/purs/failing/InfiniteKind2.purs view

file too large to diff

+ tests/purs/failing/InfiniteType.out view

file too large to diff

+ tests/purs/failing/InstanceChainBothUnknownAndMatch.out view

file too large to diff

+ tests/purs/failing/InstanceChainSkolemUnknownMatch.out view

file too large to diff

tests/purs/failing/InstanceChainSkolemUnknownMatch.purs view

file too large to diff

+ tests/purs/failing/InstanceExport.out view

file too large to diff

+ tests/purs/failing/InstanceSigsBodyIncorrect.out view

file too large to diff

+ tests/purs/failing/InstanceSigsDifferentTypes.out view

file too large to diff

+ tests/purs/failing/InstanceSigsIncorrectType.out view

file too large to diff

+ tests/purs/failing/InstanceSigsOrphanTypeDeclaration.out view

file too large to diff

+ tests/purs/failing/IntOutOfRange.out view

file too large to diff

+ tests/purs/failing/InvalidCoercibleInstanceDeclaration.out view

file too large to diff

+ tests/purs/failing/InvalidCoercibleInstanceDeclaration.purs view

file too large to diff

+ tests/purs/failing/InvalidDerivedInstance.out view

file too large to diff

+ tests/purs/failing/InvalidDerivedInstance2.out view

file too large to diff

+ tests/purs/failing/InvalidDerivedInstance3.out view

file too large to diff

+ tests/purs/failing/InvalidDerivedInstance3.purs view

file too large to diff

+ tests/purs/failing/InvalidOperatorInBinder.out view

file too large to diff

+ tests/purs/failing/KindError.out view

file too large to diff

+ tests/purs/failing/KindStar.out view

file too large to diff

+ tests/purs/failing/LacksWithSubGoal.out view

file too large to diff

+ tests/purs/failing/LeadingZeros1.out view

file too large to diff

+ tests/purs/failing/LeadingZeros2.out view

file too large to diff

+ tests/purs/failing/Let.out view

file too large to diff

+ tests/purs/failing/LetPatterns1.out view

file too large to diff

+ tests/purs/failing/LetPatterns2.out view

file too large to diff

+ tests/purs/failing/LetPatterns3.out view

file too large to diff

+ tests/purs/failing/LetPatterns4.out view

file too large to diff

+ tests/purs/failing/MPTCs.out view

file too large to diff

+ tests/purs/failing/MissingClassExport.out view

file too large to diff

+ tests/purs/failing/MissingClassMember.out view

file too large to diff

+ tests/purs/failing/MissingClassMemberExport.out view

file too large to diff

+ tests/purs/failing/MissingFFIImplementations.out view

file too large to diff

+ tests/purs/failing/MissingRecordField.out view

file too large to diff

+ tests/purs/failing/MixedAssociativityError.out view

file too large to diff

+ tests/purs/failing/MonoKindDataBindingGroup.out view

file too large to diff

+ tests/purs/failing/MonoKindDataBindingGroup.purs view

file too large to diff

+ tests/purs/failing/MultipleErrors.out view

file too large to diff

+ tests/purs/failing/MultipleErrors2.out view

file too large to diff

+ tests/purs/failing/MultipleTypeOpFixities.out view

file too large to diff

+ tests/purs/failing/MultipleValueOpFixities.out view

file too large to diff

+ tests/purs/failing/MutRec.out view

file too large to diff

+ tests/purs/failing/MutRec2.out view

file too large to diff

+ tests/purs/failing/NewtypeInstance.out view

file too large to diff

+ tests/purs/failing/NewtypeInstance2.out view

file too large to diff

+ tests/purs/failing/NewtypeInstance3.out view

file too large to diff

+ tests/purs/failing/NewtypeInstance4.out view

file too large to diff

+ tests/purs/failing/NewtypeInstance5.out view

file too large to diff

+ tests/purs/failing/NewtypeInstance6.out view

file too large to diff

+ tests/purs/failing/NewtypeMultiArgs.out view

file too large to diff

+ tests/purs/failing/NewtypeMultiCtor.out view

file too large to diff

+ tests/purs/failing/NonAssociativeError.out view

file too large to diff

+ tests/purs/failing/NonExhaustivePatGuard.out view

file too large to diff

+ tests/purs/failing/NullaryAbs.out view

file too large to diff

+ tests/purs/failing/Object.out view

file too large to diff

+ tests/purs/failing/OperatorAliasNoExport.out view

file too large to diff

+ tests/purs/failing/OperatorAt.out view

file too large to diff

+ tests/purs/failing/OperatorBackslash.out view

file too large to diff

+ tests/purs/failing/OperatorSections.out view

file too large to diff

+ tests/purs/failing/OrphanInstance.out view

file too large to diff

+ tests/purs/failing/OrphanInstance/Class.out view

file too large to diff

+ tests/purs/failing/OrphanInstanceFunDepCycle.out view

file too large to diff

+ tests/purs/failing/OrphanInstanceFunDepCycle/Lib.out view

file too large to diff

+ tests/purs/failing/OrphanInstanceNullary.out view

file too large to diff

+ tests/purs/failing/OrphanInstanceNullary/Lib.out view

file too large to diff

+ tests/purs/failing/OrphanInstanceWithDetermined.out view

file too large to diff

+ tests/purs/failing/OrphanInstanceWithDetermined/Lib.out view

file too large to diff

+ tests/purs/failing/OrphanKindDeclaration1.out view

file too large to diff

+ tests/purs/failing/OrphanKindDeclaration1.purs view

file too large to diff

+ tests/purs/failing/OrphanKindDeclaration2.out view

file too large to diff

+ tests/purs/failing/OrphanKindDeclaration2.purs view

file too large to diff

+ tests/purs/failing/OrphanRoleDeclaration1.out view

file too large to diff

+ tests/purs/failing/OrphanRoleDeclaration1.purs view

file too large to diff

+ tests/purs/failing/OrphanRoleDeclaration2.out view

file too large to diff

+ tests/purs/failing/OrphanRoleDeclaration2.purs view

file too large to diff

+ tests/purs/failing/OrphanRoleDeclaration3.out view

file too large to diff

+ tests/purs/failing/OrphanRoleDeclaration3.purs view

file too large to diff

+ tests/purs/failing/OrphanTypeDecl.out view

file too large to diff

+ tests/purs/failing/OverlapAcrossModules.out view

file too large to diff

+ tests/purs/failing/OverlapAcrossModules/Class.out view

file too large to diff

+ tests/purs/failing/OverlappingArguments.out view

file too large to diff

+ tests/purs/failing/OverlappingBinders.out view

file too large to diff

+ tests/purs/failing/OverlappingInstances.out view

file too large to diff

+ tests/purs/failing/OverlappingVars.out view

file too large to diff

+ tests/purs/failing/PolykindGeneralizationLet.out view

file too large to diff

+ tests/purs/failing/PolykindGeneralizationLet.purs view

file too large to diff

+ tests/purs/failing/PolykindInstanceOverlapping.out view

file too large to diff

+ tests/purs/failing/PolykindInstanceOverlapping.purs view

file too large to diff

+ tests/purs/failing/PolykindInstantiatedInstance.out view

file too large to diff

+ tests/purs/failing/PolykindInstantiatedInstance.purs view

file too large to diff

+ tests/purs/failing/PolykindInstantiation.out view

file too large to diff

+ tests/purs/failing/PolykindInstantiation.purs view

file too large to diff

+ tests/purs/failing/PossiblyInfiniteCoercibleInstance.out view

file too large to diff

+ tests/purs/failing/PossiblyInfiniteCoercibleInstance.purs view

file too large to diff

+ tests/purs/failing/PrimModuleReserved.out view

file too large to diff

+ tests/purs/failing/PrimRow.out view

file too large to diff

+ tests/purs/failing/PrimSubModuleReserved.out view

file too large to diff

+ tests/purs/failing/PrimSubModuleReserved/Prim_Foobar.out view

file too large to diff

+ tests/purs/failing/ProgrammableTypeErrors.out view

file too large to diff

+ tests/purs/failing/ProgrammableTypeErrorsTypeString.out view

file too large to diff

+ tests/purs/failing/QualifiedOperators.out view

file too large to diff

+ tests/purs/failing/QualifiedOperators.purs view

file too large to diff

+ tests/purs/failing/QualifiedOperators2.out view

file too large to diff

+ tests/purs/failing/QualifiedOperators2.purs view

file too large to diff

+ tests/purs/failing/QuantificationCheckFailure.out view

file too large to diff

+ tests/purs/failing/QuantificationCheckFailure.purs view

file too large to diff

+ tests/purs/failing/QuantificationCheckFailure2.out view

file too large to diff

+ tests/purs/failing/QuantificationCheckFailure2.purs view

file too large to diff

+ tests/purs/failing/QuantificationCheckFailure3.out view

file too large to diff

+ tests/purs/failing/QuantificationCheckFailure3.purs view

file too large to diff

+ tests/purs/failing/QuantifiedKind.out view

file too large to diff

+ tests/purs/failing/QuantifiedKind.purs view

file too large to diff

+ tests/purs/failing/Rank2Types.out view

file too large to diff

+ tests/purs/failing/RequiredHiddenType.out view

file too large to diff

+ tests/purs/failing/Reserved.out view

file too large to diff

+ tests/purs/failing/RoleDeclarationArityMismatch.out view

file too large to diff

+ tests/purs/failing/RoleDeclarationArityMismatch.purs view

file too large to diff

+ tests/purs/failing/RoleDeclarationArityMismatchForeign.out view

file too large to diff

+ tests/purs/failing/RoleDeclarationArityMismatchForeign.purs view

file too large to diff

+ tests/purs/failing/RowConstructors1.out view

file too large to diff

+ tests/purs/failing/RowConstructors2.out view

file too large to diff

+ tests/purs/failing/RowConstructors3.out view

file too large to diff

+ tests/purs/failing/RowInInstanceNotDetermined0.out view

file too large to diff

+ tests/purs/failing/RowInInstanceNotDetermined1.out view

file too large to diff

+ tests/purs/failing/RowInInstanceNotDetermined2.out view

file too large to diff

+ tests/purs/failing/RowLacks.out view

file too large to diff

+ tests/purs/failing/RowsInKinds.out view

file too large to diff

+ tests/purs/failing/RowsInKinds.purs view

file too large to diff

+ tests/purs/failing/ScopedKindVariableSynonym.out view

file too large to diff

+ tests/purs/failing/ScopedKindVariableSynonym.purs view

file too large to diff

+ tests/purs/failing/SelfImport.out view

file too large to diff

+ tests/purs/failing/SelfImport/Dummy.out view

file too large to diff

+ tests/purs/failing/SkolemEscape.out view

file too large to diff

+ tests/purs/failing/SkolemEscape2.out view

file too large to diff

+ tests/purs/failing/SkolemEscapeKinds.out view

file too large to diff

+ tests/purs/failing/SkolemEscapeKinds.purs view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures1.out view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures1.purs view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures2.out view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures2.purs view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures3.out view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures3.purs view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures4.out view

file too large to diff

+ tests/purs/failing/StandaloneKindSignatures4.purs view

file too large to diff

+ tests/purs/failing/SuggestComposition.out view

file too large to diff

+ tests/purs/failing/Superclasses1.out view

file too large to diff

+ tests/purs/failing/Superclasses2.out view

file too large to diff

+ tests/purs/failing/Superclasses3.out view

file too large to diff

+ tests/purs/failing/Superclasses5.out view

file too large to diff

+ tests/purs/failing/TooFewClassInstanceArgs.out view

file too large to diff

+ tests/purs/failing/TopLevelCaseNoArgs.out view

file too large to diff

+ tests/purs/failing/TransitiveDctorExport.out view

file too large to diff

+ tests/purs/failing/TransitiveDctorExportError.out view

file too large to diff

+ tests/purs/failing/TransitiveDctorExportError.purs view

file too large to diff

+ tests/purs/failing/TransitiveKindExport.out view

file too large to diff

+ tests/purs/failing/TransitiveSynonymExport.out view

file too large to diff

+ tests/purs/failing/TypeClasses2.out view

file too large to diff

+ tests/purs/failing/TypeError.out view

file too large to diff

+ tests/purs/failing/TypeOperatorAliasNoExport.out view

file too large to diff

+ tests/purs/failing/TypeSynonymCycle.out view

file too large to diff

+ tests/purs/failing/TypeSynonymCycle.purs view

file too large to diff

+ tests/purs/failing/TypeSynonyms.out view

file too large to diff

− tests/purs/failing/TypeSynonyms2.purs

file too large to diff

− tests/purs/failing/TypeSynonyms3.purs

file too large to diff

+ tests/purs/failing/TypeSynonyms4.out view

file too large to diff

+ tests/purs/failing/TypeSynonyms5.out view

file too large to diff

+ tests/purs/failing/TypeSynonyms7.out view

file too large to diff

+ tests/purs/failing/TypeSynonyms7.purs view

file too large to diff

+ tests/purs/failing/TypeSynonymsOverlappingInstance.out view

file too large to diff

+ tests/purs/failing/TypeSynonymsOverlappingInstance.purs view

file too large to diff

+ tests/purs/failing/TypeWildcards1.out view

file too large to diff

+ tests/purs/failing/TypeWildcards2.out view

file too large to diff

+ tests/purs/failing/TypeWildcards3.out view

file too large to diff

+ tests/purs/failing/TypeWildcards4.out view

file too large to diff

+ tests/purs/failing/TypeWildcards4.purs view

file too large to diff

+ tests/purs/failing/TypedBinders.out view

file too large to diff

+ tests/purs/failing/TypedBinders2.out view

file too large to diff

+ tests/purs/failing/TypedBinders3.out view

file too large to diff

+ tests/purs/failing/TypedHole.out view

file too large to diff

+ tests/purs/failing/TypedHole2.out view

file too large to diff

+ tests/purs/failing/UnderscoreModuleName.out view

file too large to diff

+ tests/purs/failing/UnknownType.out view

file too large to diff

+ tests/purs/failing/UnsupportedRoleDeclarationTypeClass.out view

file too large to diff

+ tests/purs/failing/UnsupportedRoleDeclarationTypeClass.purs view

file too large to diff

+ tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.out view

file too large to diff

+ tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.purs view

file too large to diff

+ tests/purs/failing/UnsupportedTypeInKind.out view

file too large to diff

+ tests/purs/failing/UnsupportedTypeInKind.purs view

file too large to diff

+ tests/purs/failing/UnusableTypeClassMethod.out view

file too large to diff

+ tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out view

file too large to diff

+ tests/purs/failing/UnusableTypeClassMethodSynonym.out view

file too large to diff

+ tests/purs/failing/Whitespace1.out view

file too large to diff

tests/purs/graph/graph.json view

file too large to diff

tests/purs/graph/src/Module2.purs view

file too large to diff

+ tests/purs/graph/src/Module3.purs view

file too large to diff

− tests/purs/layout/AdoIn.purs

file too large to diff

− tests/purs/layout/CaseGuards.purs

file too large to diff

− tests/purs/layout/CaseWhere.purs

file too large to diff

− tests/purs/layout/ClassHead.purs

file too large to diff

− tests/purs/layout/Commas.purs

file too large to diff

− tests/purs/layout/Delimiter.purs

file too large to diff

− tests/purs/layout/DoLet.purs

file too large to diff

− tests/purs/layout/DoOperator.purs

file too large to diff

− tests/purs/layout/DoWhere.purs

file too large to diff

− tests/purs/layout/IfThenElseDo.purs

file too large to diff

− tests/purs/layout/InstanceChainElse.purs

file too large to diff

− tests/purs/layout/LetGuards.purs

file too large to diff

− tests/purs/passing/2172.js

file too large to diff

− tests/purs/passing/2172.purs

file too large to diff

+ tests/purs/passing/3830.purs view

file too large to diff

+ tests/purs/passing/BlockStringEdgeCases.purs view

file too large to diff

+ tests/purs/passing/Coercible.purs view

file too large to diff

+ tests/purs/passing/Coercible/Lib.purs view

file too large to diff

+ tests/purs/passing/Coercible/Lib2.purs view

file too large to diff

tests/purs/passing/ExportExplicit/M1.purs view

file too large to diff

+ tests/purs/passing/ForeignDataInKind.purs view

file too large to diff

tests/purs/passing/GenericsRep.purs view

file too large to diff

tests/purs/passing/Guards.purs view

file too large to diff

+ tests/purs/passing/KindUnificationInSolver.purs view

file too large to diff

tests/purs/passing/KindedType.purs view

file too large to diff

+ tests/purs/passing/MinusConstructor.purs view

file too large to diff

tests/purs/passing/NegativeBinder.purs view

file too large to diff

tests/purs/passing/NewtypeClass.purs view

file too large to diff

+ tests/purs/passing/PolykindBindingGroup1.purs view

file too large to diff

+ tests/purs/passing/PolykindBindingGroup2.purs view

file too large to diff

+ tests/purs/passing/PolykindGeneralization.purs view

file too large to diff

+ tests/purs/passing/PolykindGeneralizationHygiene.purs view

file too large to diff

+ tests/purs/passing/PolykindGeneralizedTypeSynonym.purs view

file too large to diff

+ tests/purs/passing/PolykindInstanceDispatch.purs view

file too large to diff

+ tests/purs/passing/PolykindInstantiatedInstance.purs view

file too large to diff

+ tests/purs/passing/PolykindInstantiation.purs view

file too large to diff

+ tests/purs/passing/PolykindRowCons.purs view

file too large to diff

+ tests/purs/passing/QualifiedOperators.purs view

file too large to diff

+ tests/purs/passing/QualifiedOperators/Foo.purs view

file too large to diff

+ tests/purs/passing/QuantifiedKind.purs view

file too large to diff

+ tests/purs/passing/Rank2Kinds.purs view

file too large to diff

+ tests/purs/passing/ReExportsExported.js view

file too large to diff

+ tests/purs/passing/ReExportsExported.purs view

file too large to diff

+ tests/purs/passing/ReExportsExported/A.purs view

file too large to diff

+ tests/purs/passing/ReExportsExported/B.purs view

file too large to diff

+ tests/purs/passing/ReExportsExported/C.purs view

file too large to diff

tests/purs/passing/RowLacks.purs view

file too large to diff

tests/purs/passing/RowsInInstanceContext.purs view

file too large to diff

+ tests/purs/passing/RowsInKinds.purs view

file too large to diff

+ tests/purs/passing/RowsInKinds2.purs view

file too large to diff

tests/purs/passing/SolvingAppendSymbol.purs view

file too large to diff

tests/purs/passing/SolvingCompareSymbol.purs view

file too large to diff

+ tests/purs/passing/StandaloneKindSignatures.purs view

file too large to diff

tests/purs/passing/TypeOperators.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymInSuperClass.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymInstance.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymInstance2.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymInstance3.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymInstance4.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymInstance5.purs view

file too large to diff

+ tests/purs/passing/TypeSynonymsInKinds.purs view

file too large to diff

tests/purs/publish/basic-example/output/Control.Applicative/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Control.Apply/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Control.Bind/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Control.Category/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Control.Monad/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Control.Semigroupoid/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.BooleanAlgebra/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Bounded.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Bounded/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.CommutativeRing/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.DivisionRing/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Eq.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Eq/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.EuclideanRing/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Field/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Function/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Functor/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Generic.Rep/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.HeytingAlgebra.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.HeytingAlgebra/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid.Additive/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid.Conj/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid.Disj/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid.Dual/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid.Endo/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Monoid.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid.Multiplicative/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Monoid/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.NaturalTransformation/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Newtype/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Ord.Generic/docs.json view

file too large to diff

− tests/purs/publish/basic-example/output/Data.Ord.Unsafe/docs.json

file too large to diff

tests/purs/publish/basic-example/output/Data.Ord/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Ring.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Ring/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Semigroup.First/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Semigroup.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Semigroup.Last/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Semigroup/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Semiring.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Semiring/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Data.Show.Generic/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Show/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Symbol/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Unit/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Data.Void/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Effect.Class.Console/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Effect.Class/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Effect.Console/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Effect.Uncurried/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Effect/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Main/docs.json view

file too large to diff

− tests/purs/publish/basic-example/output/PSCI.Support/docs.json

file too large to diff

tests/purs/publish/basic-example/output/Prim.Boolean/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Prim.Coerce/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Prim.Ordering/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Prim.Row/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Prim.RowList/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Prim.Symbol/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Prim.TypeError/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Prim/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Record.Unsafe/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Safe.Coerce/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Type.Data.Row/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/Type.Data.RowList/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Type.Proxy/docs.json view

file too large to diff

+ tests/purs/publish/basic-example/output/Unsafe.Coerce/docs.json view

file too large to diff

tests/purs/publish/basic-example/output/cache-db.json view

file too large to diff

− tests/purs/publish/basic-example/resolutions-legacy.json

file too large to diff

tests/purs/publish/basic-example/resolutions.json view

file too large to diff

+ tests/purs/warning/2140.out view

file too large to diff

+ tests/purs/warning/2383.out view

file too large to diff

+ tests/purs/warning/2411.out view

file too large to diff

+ tests/purs/warning/2542.out view

file too large to diff

+ tests/purs/warning/CoercibleUnusedImport.out view

file too large to diff

+ tests/purs/warning/CoercibleUnusedImport.purs view

file too large to diff

+ tests/purs/warning/CoercibleUnusedImport/N1.purs view

file too large to diff

+ tests/purs/warning/CoercibleUnusedImport/N2.purs view

file too large to diff

+ tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.out view

file too large to diff

+ tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.purs view

file too large to diff

+ tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport/N.purs view

file too large to diff

+ tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.out view

file too large to diff

+ tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.purs view

file too large to diff

+ tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport/N.purs view

file too large to diff

+ tests/purs/warning/CustomWarning.out view

file too large to diff

+ tests/purs/warning/CustomWarning2.out view

file too large to diff

+ tests/purs/warning/CustomWarning3.out view

file too large to diff

+ tests/purs/warning/CustomWarning4.out view

file too large to diff

+ tests/purs/warning/DeprecatedConstraintInForeignImport.js view

file too large to diff

+ tests/purs/warning/DeprecatedConstraintInForeignImport.out view

file too large to diff

+ tests/purs/warning/DeprecatedConstraintInForeignImport.purs view

file too large to diff

+ tests/purs/warning/DeprecatedFFIPrime.js view

file too large to diff

+ tests/purs/warning/DeprecatedFFIPrime.out view

file too large to diff

+ tests/purs/warning/DeprecatedFFIPrime.purs view

file too large to diff

+ tests/purs/warning/DeprecatedForeignImportKind.out view

file too large to diff

+ tests/purs/warning/DeprecatedForeignImportKind.purs view

file too large to diff

+ tests/purs/warning/DeprecatedImportExportKinds.out view

file too large to diff

+ tests/purs/warning/DeprecatedImportExportKinds.purs view

file too large to diff

+ tests/purs/warning/DeprecatedImportExportKinds/Lib.purs view

file too large to diff

+ tests/purs/warning/DeprecatedRowKindSyntax.out view

file too large to diff

+ tests/purs/warning/DeprecatedRowKindSyntax.purs view

file too large to diff

+ tests/purs/warning/DuplicateExportRef.out view

file too large to diff

tests/purs/warning/DuplicateExportRef.purs view

file too large to diff

+ tests/purs/warning/DuplicateImport.out view

file too large to diff

+ tests/purs/warning/DuplicateImportRef.out view

file too large to diff

+ tests/purs/warning/DuplicateSelectiveImport.out view

file too large to diff

+ tests/purs/warning/HiddenConstructorsGeneric.out view

file too large to diff

+ tests/purs/warning/HiddenConstructorsGeneric.purs view

file too large to diff

+ tests/purs/warning/HiddenConstructorsNewtype.out view

file too large to diff

+ tests/purs/warning/HiddenConstructorsNewtype.purs view

file too large to diff

+ tests/purs/warning/HidingImport.out view

file too large to diff

+ tests/purs/warning/ImplicitImport.out view

file too large to diff

+ tests/purs/warning/ImplicitQualifiedImport.out view

file too large to diff

+ tests/purs/warning/ImplicitQualifiedImportReExport.out view

file too large to diff

+ tests/purs/warning/Kind-UnusedExplicitImport-1.out view

file too large to diff

tests/purs/warning/Kind-UnusedExplicitImport-1.purs view

file too large to diff

+ tests/purs/warning/Kind-UnusedExplicitImport-2.out view

file too large to diff

tests/purs/warning/Kind-UnusedExplicitImport-2.purs view

file too large to diff

+ tests/purs/warning/Kind-UnusedImport.out view

file too large to diff

tests/purs/warning/Kind-UnusedImport.purs view

file too large to diff

+ tests/purs/warning/KindReExport.out view

file too large to diff

tests/purs/warning/KindReExport.purs view

file too large to diff

+ tests/purs/warning/MissingKindDeclaration.out view

file too large to diff

+ tests/purs/warning/MissingKindDeclaration.purs view

file too large to diff

+ tests/purs/warning/MissingTypeDeclaration.out view

file too large to diff

+ tests/purs/warning/NewtypeInstance.out view

file too large to diff

+ tests/purs/warning/NewtypeInstance2.out view

file too large to diff

+ tests/purs/warning/NewtypeInstance3.out view

file too large to diff

+ tests/purs/warning/NewtypeInstance4.out view

file too large to diff

+ tests/purs/warning/OverlappingPattern.out view

file too large to diff

+ tests/purs/warning/ScopeShadowing.out view

file too large to diff

+ tests/purs/warning/ScopeShadowing2.out view

file too large to diff

+ tests/purs/warning/ShadowedBinderPatternGuard.out view

file too large to diff

+ tests/purs/warning/ShadowedNameParens.out view

file too large to diff

+ tests/purs/warning/ShadowedTypeVar.out view

file too large to diff

+ tests/purs/warning/UnambiguousQuantifiedKind.out view

file too large to diff

+ tests/purs/warning/UnambiguousQuantifiedKind.purs view

file too large to diff

+ tests/purs/warning/UnnecessaryFFIModule.out view

file too large to diff

+ tests/purs/warning/UnusedDctorExplicitImport.out view

file too large to diff

+ tests/purs/warning/UnusedDctorImportAll.out view

file too large to diff

+ tests/purs/warning/UnusedDctorImportExplicit.out view

file too large to diff

+ tests/purs/warning/UnusedExplicitImport.out view

file too large to diff

+ tests/purs/warning/UnusedExplicitImportTypeOp.out view

file too large to diff

tests/purs/warning/UnusedExplicitImportTypeOp/Lib.purs view

file too large to diff

+ tests/purs/warning/UnusedExplicitImportValOp.out view

file too large to diff

+ tests/purs/warning/UnusedFFIImplementations.out view

file too large to diff

+ tests/purs/warning/UnusedImport.out view

file too large to diff

+ tests/purs/warning/UnusedTypeVar.out view

file too large to diff

+ tests/purs/warning/WildcardInferredType.out view

file too large to diff

+ tests/purs/warning/WildcardInferredType2.out view

file too large to diff

tests/support/bower.json view

file too large to diff

tests/support/package-lock.json view

file too large to diff

+ tests/support/pscide/src/CompletionSpec.purs view

file too large to diff