purescript 0.9.3 → 0.10.0

raw patch · 112 files changed

+2849/−1010 lines, 112 filesdep +data-ordlistdep ~aesondep ~bower-jsondep ~http-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: data-ordlist

Dependency ranges changed: aeson, bower-json, http-client

API changes (from Hackage documentation)

Files

• CONTRIBUTING.md +2/−3
• CONTRIBUTORS.md +9/−4
• INSTALL.md +6/−3
• LICENSE +790/−80
• examples/docs/src/ExplicitTypeSignatures.purs +2/−0
• examples/failing/CannotDeriveNewtypeForData.purs +8/−0
• examples/failing/DoNotSuggestComposition2.purs +1/−1
• examples/failing/NewtypeInstance.purs +8/−0
• examples/failing/NewtypeInstance2.purs +8/−0
• examples/failing/NewtypeInstance3.purs +8/−0
• examples/failing/NewtypeInstance4.purs +8/−0
• examples/failing/NonWildcardNewtypeInstance.purs +8/−0
• examples/failing/OperatorSections.purs +1/−2
• examples/failing/OverlappingVars.purs +0/−1
• examples/failing/ProgrammableTypeErrorsTypeString.purs +18/−0
• examples/failing/TypeWildcards3.purs +1/−2
• examples/failing/UnifyInTypeInstanceLookup.purs +0/−22
• examples/passing/1807.purs +14/−0
• examples/passing/ConstraintParsingIssue.purs +9/−0
• examples/passing/DeriveNewtype.purs +17/−0
• examples/passing/FunWithFunDeps.js +32/−0
• examples/passing/FunWithFunDeps.purs +41/−0
• examples/passing/FunctionalDependencies.purs +21/−0
• examples/passing/GHCGenerics.purs +140/−0
• examples/passing/NewtypeClass.purs +39/−0
• examples/passing/NewtypeInstance.purs +30/−0
• examples/passing/NumberLiterals.purs +2/−2
• examples/passing/RowPolyInstanceContext.purs +1/−1
• examples/passing/Stream.purs +26/−0
• examples/passing/UnifyInTypeInstanceLookup.purs +25/−0
• examples/passing/WildcardInInstance.purs +23/−0
• hierarchy/Main.hs +21/−18
• psc-bundle/Main.hs +28/−25
• psc-docs/Tags.hs +1/−1
• psc-ide-client/Main.hs +8/−5
• psc-ide-server/Main.hs +13/−12
• psc-publish/Main.hs +13/−10
• psc/Main.hs +10/−4
• psci/Main.hs +3/−3
• purescript.cabal +8/−5
• src/Control/Monad/Supply/Class.hs +4/−0
• src/Language/PureScript/AST/Declarations.hs +18/−14
• src/Language/PureScript/AST/Exported.hs +1/−1
• src/Language/PureScript/AST/Traversals.hs +9/−9
• src/Language/PureScript/Bundle.hs +19/−7
• src/Language/PureScript/CodeGen/JS.hs +4/−4
• src/Language/PureScript/CodeGen/JS/Optimizer.hs +0/−6
• src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs +7/−4
• src/Language/PureScript/CoreFn/Desugar.hs +1/−1
• src/Language/PureScript/CoreFn/ToJSON.hs +116/−0
• src/Language/PureScript/Docs/Convert/Single.hs +2/−2
• src/Language/PureScript/Environment.hs +42/−28
• src/Language/PureScript/Errors.hs +56/−30
• src/Language/PureScript/Externs.hs +27/−26
• src/Language/PureScript/Ide.hs +6/−6
• src/Language/PureScript/Ide/Command.hs +1/−1
• src/Language/PureScript/Ide/Completion.hs +7/−8
• src/Language/PureScript/Ide/Externs.hs +22/−14
• src/Language/PureScript/Ide/Imports.hs +2/−2
• src/Language/PureScript/Ide/Matcher.hs +8/−8
• src/Language/PureScript/Ide/Pursuit.hs +20/−24
• src/Language/PureScript/Ide/Rebuild.hs +2/−1
• src/Language/PureScript/Ide/Reexports.hs +2/−4
• src/Language/PureScript/Ide/SourceFile.hs +24/−1
• src/Language/PureScript/Ide/State.hs +86/−18
• src/Language/PureScript/Ide/Types.hs +48/−65
• src/Language/PureScript/Ide/Util.hs +41/−25
• src/Language/PureScript/Interactive/Completion.hs +2/−2
• src/Language/PureScript/Interactive/Printer.hs +11/−11
• src/Language/PureScript/Interactive/Types.hs +2/−2
• src/Language/PureScript/Linter/Imports.hs +2/−2
• src/Language/PureScript/Make.hs +9/−0
• src/Language/PureScript/Options.hs +4/−1
• src/Language/PureScript/Parser/Declarations.hs +10/−3
• src/Language/PureScript/Parser/Lexer.hs +7/−0
• src/Language/PureScript/Parser/Types.hs +2/−4
• src/Language/PureScript/Pretty/Common.hs +1/−1
• src/Language/PureScript/Pretty/Types.hs +4/−4
• src/Language/PureScript/Pretty/Values.hs +1/−3
• src/Language/PureScript/Publish/ErrorsWarnings.hs +8/−8
• src/Language/PureScript/Renamer.hs +3/−3
• src/Language/PureScript/Sugar/Names.hs +2/−2
• src/Language/PureScript/Sugar/Names/Exports.hs +1/−1
• src/Language/PureScript/Sugar/ObjectWildcards.hs +17/−10
• src/Language/PureScript/Sugar/Operators.hs +4/−4
• src/Language/PureScript/Sugar/Operators/Common.hs +2/−2
• src/Language/PureScript/Sugar/Operators/Expr.hs +1/−1
• src/Language/PureScript/Sugar/TypeClasses.hs +25/−18
• src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +88/−5
• src/Language/PureScript/TypeChecker.hs +27/−13
• src/Language/PureScript/TypeChecker/Entailment.hs +349/−142
• src/Language/PureScript/TypeChecker/Kinds.hs +7/−8
• src/Language/PureScript/TypeChecker/Monad.hs +30/−18
• src/Language/PureScript/TypeChecker/Skolems.hs +3/−3
• src/Language/PureScript/TypeChecker/Subsumption.hs +17/−8
• src/Language/PureScript/TypeChecker/Types.hs +122/−116
• src/Language/PureScript/TypeChecker/Unify.hs +1/−31
• src/Language/PureScript/TypeClassDictionaries.hs +0/−23
• src/Language/PureScript/Types.hs +2/−2
• stack.yaml +10/−3
• tests/Language/PureScript/Ide/ImportsSpec.hs +1/−1
• tests/Language/PureScript/Ide/Integration.hs +8/−20
• tests/Language/PureScript/Ide/MatcherSpec.hs +9/−7
• tests/Language/PureScript/Ide/ReexportsSpec.hs +1/−1
• tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs +13/−8
• tests/Language/PureScript/Ide/SourceFileSpec.hs +7/−3
• tests/Language/PureScript/Ide/StateSpec.hs +51/−0
• tests/TestDocs.hs +1/−0
• tests/TestPscIde.hs +1/−0
• tests/TestPsci.hs +0/−1
• tests/TestUtils.hs +2/−0
• tests/support/bower.json +3/−2

@@ -11,9 +11,8 @@ Please follow the following guidelines:  - Add at least a test to `examples/passing/` and possibly to `examples/failing`.-- Build the binaries and libs with `cabal build`-- Install the binaries and libs with `cabal install`.-- Run `cabal configure --enable-tests && cabal build && cabal test` to build the test suite. You will need `npm` and `node` on your PATH to run the tests.+- Build the binaries and libs with `stack build`+- Run the test suite with `stack test`. You will need `npm` and `node` on your PATH to run the tests. - Build the core libraries by running the script in `core-tests`.  ## Code Review

@@ -12,8 +12,11 @@ - [@bagl](https://github.com/bagl) (Petr Vapenka) My existing contributions and all future contributions until further notice are Copyright Petr Vapenka, 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). - [@balajirrao](https://github.com/balajirrao) (Balaji Rao) - My existing contributions and all future contributions until further notice are Copyright Balaji Rao, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license. - [@bergmark](https://github.com/bergmark) (Adam Bergmark) - My existing contributions and all future contributions until further notice are Copyright Adam Bergmark, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.+- [@bmjames](https://github.com/bmjames) (Ben James) My existing contributions and all future contributions until further notice are Copyright Ben James, 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). - [@Bogdanp](https://github.com/Bogdanp) (Bogdan Paul Popa) My existing contributions and all future contributions until further notice are Copyright Bogdan Paul Popa, 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).+- [@bsermons](https://github.com/bsermons) (Brian Sermons) My existing contributions and all future contributions until further notice are Copyright Brian Sermons, 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). - [@cdepillabout](https://github.com/cdepillabout) (Dennis Gosnell) My existing contributions and all future contributions until further notice are Copyright Dennis Gosnell, 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).+- [@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). - [@codedmart](https://github.com/codedmart) (Brandon Martin) My existing contributions and all future contributions until further notice are Copyright Brandon Martin, 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). - [@davidchambers](https://github.com/davidchambers) (David Chambers) My existing contributions and all future contributions until further notice are Copyright David Chambers, 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).@@ -25,8 +28,11 @@ - [@erdeszt](https://github.com/erdeszt) (Tibor Erdesz) My existing contributions and all future contributions until further notice are Copyright Tibor Erdesz, 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). - [@etrepum](https://github.com/etrepum) (Bob Ippolito) My existing contributions and all future contributions until further notice are Copyright Bob Ippolito, 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). - [@faineance](https://github.com/faineance) My existing contributions and all future contributions until further notice are Copyright faineance, 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).+- [@felixSchl](https://github.com/felixSchl) (Felix Schlitter) My existing contributions and all future contributions until further notice are Copyright Felix Schlitter, 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).+- [@FrigoEU](https://github.com/FrigoEU) (Simon Van Casteren) My existing contributions and all future contributions until further notice are Copyright Simon Van Casteren, 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). - [@garyb](https://github.com/garyb) (Gary Burgess) My existing contributions and all future contributions until further notice are Copyright Gary Burgess, 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). - [@hdgarrood](https://github.com/hdgarrood) (Harry Garrood) My existing contributions and all future contributions until further notice are Copyright Harry Garrood, 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).+- [@ianbollinger](https://github.com/ianbollinger) (Ian D. Bollinger) My existing contributions and all future contributions until further notice are Copyright Ian D. Bollinger, 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). - [@ilovezfs](https://github.com/ilovezfs) - My existing contributions and all future contributions until further notice are Copyright ilovezfs, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license - [@izgzhen](https://github.com/izgzhen) (Zhen Zhang) My existing contributions and all future contributions until further notice are Copyright Zhen Zhang, 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). - [@jacereda](https://github.com/jacereda) (Jorge Acereda) My existing contributions and all future contributions until further notice are Copyright Jorge Acereda, 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).@@ -36,6 +42,7 @@ - [@kRITZCREEK](https://github.com/kRITZCREEK) (Christoph Hegemann) - My existing contributions and all future contributions until further notice are Copyright Christoph Hegemann, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license. - [@L8D](https://github.com/L8D) (Tenor Biel) My existing contributions and all future contributions until further notice are Copyright Tenor Biel, 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).+- [@LiamGoodacre](https://github.com/LiamGoodacre) (Liam Goodacre) My existing contributions and all future contributions until further notice are Copyright Liam Goodacre, 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). - [@lukerandall](https://github.com/lukerandall) (Luke Randall) My existing contributions and all future contributions until further notice are Copyright Luke Randall, 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). - [@mgmeier](https://github.com/mgmeier) (Michael Karg) My existing contributions and all future contributions until further notice are Copyright Michael Gilliland, 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). - [@michaelficarra](https://github.com/michaelficarra) (Michael Ficarra) My existing contributions and all future contributions until further notice are Copyright Michael Ficarra, 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).@@ -57,8 +64,10 @@ - [@philopon](https://github.com/philopon) (Hirotomo Moriwaki) - My existing contributions and all future contributions until further notice are Copyright Hirotomo Moriwaki, 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). - [@pseudonom](https://github.com/pseudonom) (Eric Easley) My existing contributions and all future contributions until further notice are Copyright Eric Easley, 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). - [@puffnfresh](https://github.com/puffnfresh) (Brian McKenna) All contributions I made during June 2015 were during employment at [SlamData, Inc.](#companies) who owns the copyright. I assign copyright of all my personal contributions before June 2015 to the owners of the PureScript compiler.+- [@rightfold](https://github.com/rightfold) (rightfold) My existing contributions and all future contributions until further notice are Copyright rightfold, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](https://opensource.org/licenses/MIT). - [@robdaemon](https://github.com/robdaemon) (Robert Roland) My existing contributions and all future contributions until further notice are Copyright Robert Roland, 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). - [@RossMeikleham](https://github.com/RossMeikleham) (Ross Meikleham) My existing contributions and all future contributions until further notice are Copyright Ross Meikleham, 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).+- [@rvion](https://github.com/rvion) (Rémi Vion) My existing contributions and all future contributions until further notice are Copyright Rémi Vion, 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). - [@sebastiaanvisser](https://github.com/sebastiaanvisser) (Sebastiaan Visser) - My existing contributions and all future contributions until further notice are Copyright Sebastiaan Visser, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license. - [@senju](https://github.com/senju) - My existing contributions and all future contributions until further notice are Copyright senju, 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). - [@sharkdp](https://github.com/sharkdp) (David Peter) My existing contributions and all future contributions until further notice are Copyright David Peter, 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).@@ -70,10 +79,6 @@ - [@utkarshkukreti](https://github.com/utkarshkukreti) (Utkarsh Kukreti) My existing contributions and all future contributions until further notice are Copyright Utkarsh Kukreti, 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). - [@vkorablin](https://github.com/vkorablin) (Vladimir Korablin) - My existing contributions and all future contributions until further notice are Copyright Vladimir Korablin, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license. - [@zudov](https://github.com/zudov) (Konstantin Zudov) My existing contributions and all future contributions until further notice are Copyright Konstantin Zudov, 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).-- [@LiamGoodacre](https://github.com/LiamGoodacre) (Liam Goodacre) My existing contributions and all future contributions until further notice are Copyright Liam Goodacre, 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).-- [@bsermons](https://github.com/bsermons) (Brian Sermons) My existing contributions and all future contributions until further notice are Copyright Brian Sermons, 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).-- [@bmjames](https://github.com/bmjames) (Ben James) My existing contributions and all future contributions until further notice are Copyright Ben James, 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).-- - [@felixSchl](https://github.com/felixSchl) (Felix Schlitter) My existing contributions and all future contributions until further notice are Copyright Felix Schlitter, 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).  ### Companies 

@@ -27,16 +27,19 @@ use stack:  ```-$ stack install --resolver=nightly purescript+$ stack update+$ stack unpack purescript+$ cd purescript-x.y.z  # (replace x.y.z with whichever version you just downloaded)+$ stack install ```  This will then copy the compiler and utilities into `~/.local/bin`.  -If you don't have stack installed yet there are install instructions+If you don't have stack installed, there are install instructions [here](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md). -If you don't have ghc installed yet, stack will prompt you to run `stack setup`+If you don't have ghc installed, stack will prompt you to run `stack setup` which will install ghc for you.  ## The "curses" library

@@ -23,10 +23,13 @@ PureScript uses the following Haskell library packages. Their license files follow.    Glob+  SHA   aeson   aeson-better-errors+  aeson-pretty   ansi-terminal   ansi-wl-pprint+  appar   array   asn1-encoding   asn1-parse@@ -39,14 +42,18 @@   base64-bytestring   binary   blaze-builder+  blaze-html+  blaze-markup   bower-json   boxes   byteable+  byteorder   bytestring   bytestring-builder   case-insensitive   cereal   clock+  cmdargs   conduit   conduit-extra   connection@@ -54,25 +61,32 @@   cookie   cryptonite   data-default-class+  data-ordlist   deepseq   directory   dlist   easy-file   edit-distance+  entropy   exceptions   fail   fast-logger+  file-embed   filepath   fsnotify   ghc-prim   hashable   haskeline-  hinotify+  hex+  hfsevents   hourglass   http-client   http-client-tls+  http-date   http-types+  http2   integer-gmp+  iproute   language-javascript   lifted-base   memory@@ -96,6 +110,7 @@   primitive   process   protolude+  psqueues   random   regex-base   regex-tdfa@@ -103,6 +118,7 @@   safe   scientific   semigroups+  simple-sendfile   socks   sourcemap   spdx@@ -110,13 +126,14 @@   stm   stm-chans   streaming-commons-  string-conv+  stringsearch   syb   tagged   template-haskell   terminfo   text   time+  time-locale-compat   tls   transformers   transformers-base@@ -126,8 +143,17 @@   unix-time   unordered-containers   utf8-string+  vault   vector   void+  wai+  wai-app-static+  wai-extra+  wai-logger+  wai-websockets+  warp+  websockets+  word8   x509   x509-store   x509-system@@ -140,7 +166,7 @@   the code are held by whoever wrote the code in question: see CREDITS.txt for a   list of authors. -  Copyright (c) 2008-2012 <authors>+  Copyright (c) 2008-2016 <authors>   All rights reserved.    Redistribution and use in source and binary forms, with or without@@ -165,6 +191,38 @@   OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF   ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +SHA LICENSE file:++  Copyright (c) 2008, 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:++    * 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 the Galois, Inc. nor the names of its+      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.+ aeson LICENSE file:    Copyright (c) 2011, MailRank, Inc.@@ -221,6 +279,39 @@   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +aeson-pretty LICENSE file:++  Copyright (c)2011, Falko Peters++  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 Falko Peters 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.+ ansi-terminal LICENSE file:    Copyright (c) 2008, Maximilian Bolingbroke@@ -274,6 +365,38 @@   or otherwise) arising in any way out of the use of this software, even   if advised of the possibility of such damage. +appar LICENSE file:++  Copyright (c) 2009, IIJ Innovation Institute 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:++    * 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 the copyright holders nor the names of its+      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.+ array LICENSE file:    This library (libraries/base) is derived from code from several@@ -746,6 +869,72 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +blaze-html LICENSE file:++  Copyright Jasper Van der Jeugt 2010++  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 Jasper Van der Jeugt 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.++blaze-markup LICENSE file:++  Copyright Jasper Van der Jeugt 2010++  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 Jasper Van der Jeugt 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.+ bower-json LICENSE file:    Copyright (c) 2015 Harry Garrood@@ -829,6 +1018,39 @@   OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF   SUCH DAMAGE. +byteorder LICENSE file:++  Copyright 2009, Antoine Latter++  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 the author 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.+ bytestring LICENSE file:    Copyright (c) Don Stewart 2005-2009@@ -997,6 +1219,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. +cmdargs LICENSE file:++  Copyright Neil Mitchell 2009-2016.+  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 Neil Mitchell 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.+ conduit LICENSE file:    Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/@@ -1109,31 +1364,26 @@  cookie LICENSE file: -  The following license covers this documentation, and the source code, except-  where otherwise indicated.--  Copyright 2010, Michael Snoyman. All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions are met:+  Copyright (c) 2010 Michael Snoyman, http://www.yesodweb.com/ -  * Redistributions of source code must retain the above copyright notice, this-    list of conditions and the following disclaimer.+  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: -  * 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.+  The above copyright notice and this permission notice shall be+  included in all copies or substantial portions of the Software. -  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.+  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.  cryptonite LICENSE file: @@ -1195,6 +1445,19 @@   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. +data-ordlist LICENSE file:++  Copyright (c) 2009-2010, Melding Monads+  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 Melding Monads nor the names of its 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 HOLDER 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.+ deepseq LICENSE file:    This library (deepseq) is derived from code from the GHC project which@@ -1305,7 +1568,7 @@  dlist LICENSE file: -  Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather+  Copyright (c) 2006-2009 Don Stewart, 2013-2016 Sean Leather    All rights reserved. @@ -1394,6 +1657,39 @@   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. +entropy LICENSE file:++  Copyright (c) Thomas DuBuisson++  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.+ exceptions LICENSE file:    Copyright 2013-2015 Edward Kmett@@ -1493,6 +1789,34 @@   ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE   POSSIBILITY OF SUCH DAMAGE. +file-embed LICENSE file:++  The following license covers this documentation, and the source code, except+  where otherwise indicated.++  Copyright 2008, Michael Snoyman. 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.++  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.+ filepath LICENSE file:    Copyright Neil Mitchell 2005-2015.@@ -1683,38 +2007,42 @@   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:+hex LICENSE file: -  Copyright (c) Lennart Kolmodin+  Page not found: Sorry, it's just not here. +hfsevents LICENSE file:++  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.  hourglass LICENSE file: @@ -1792,6 +2120,38 @@   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. +http-date LICENSE file:++  Copyright (c) 2009, IIJ Innovation Institute 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:++    * 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 the copyright holders nor the names of its+      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.+ http-types LICENSE file:    Copyright (c) 2011, Aristid Breitkreuz@@ -1826,6 +2186,38 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +http2 LICENSE file:++  Copyright (c) 2013, IIJ Innovation Institute 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:++    * 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 the copyright holders nor the names of its+      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.+ integer-gmp LICENSE file:    Copyright (c) 2014, Herbert Valerio Riedel@@ -1859,6 +2251,38 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +iproute LICENSE file:++  Copyright (c) 2009, IIJ Innovation Institute 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:++    * 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 the copyright holders nor the names of its+      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.+ language-javascript LICENSE file:    Copyright (c)2010, Alan Zimmerman@@ -2622,6 +3046,40 @@   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS   IN THE SOFTWARE. +psqueues LICENSE file:++  The Glasgow Haskell Compiler License++  Copyright 2004, The University Court of the University of Glasgow.+  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 name of the University nor the names of its contributors may be+  used to endorse or promote products derived from this software without+  specific prior written permission.++  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+  GLASGOW AND 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+  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.+ random LICENSE file:    This library (libraries/base) is derived from code from two@@ -2846,6 +3304,38 @@   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.+  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 the copyright holders nor the names of its+      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.+ socks LICENSE file:    Copyright (c) 2010-2011 Vincent Hanquez <vincent@snarc.org>@@ -3068,38 +3558,9 @@   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE   SOFTWARE. -string-conv LICENSE file:--  Copyright (c) 2012, Ozgun Ataman--  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 Ozgun Ataman nor the names of other-        contributors may be used to endorse or promote products derived-        from this software without specific prior written permission.+stringsearch LICENSE file: -  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.+  Page not found: Sorry, it's just not here.  syb LICENSE file: @@ -3324,6 +3785,39 @@    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. +time-locale-compat LICENSE file:++  Copyright (c) 2014, Kei Hibino++  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 Kei Hibino 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.+ tls LICENSE file:    Copyright (c) 2010-2015 Vincent Hanquez <vincent@snarc.org>@@ -3609,6 +4103,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. +vault LICENSE file:++  Copyright (c)2011, Heinrich Apfelmus++  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 Heinrich Apfelmus 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.+ vector LICENSE file:    Copyright (c) 2008-2012, Roman Leshchinskiy@@ -3672,6 +4199,189 @@   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.++wai 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.++wai-app-static 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.++wai-extra 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.++wai-logger LICENSE file:++  Copyright (c) 2009, IIJ Innovation Institute 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:++    * 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 the copyright holders nor the names of its+      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.++wai-websockets 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.++warp 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.++websockets LICENSE file:++  Page not found: Sorry, it's just not here.++word8 LICENSE file:++  Copyright (c) 2012, IIJ Innovation Institute 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:++    * 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 the copyright holders nor the names of its+      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. 

@@ -14,3 +14,5 @@  -- This should infer a type. aNumber = 1.0++foreign import nestedForAll :: forall c. (forall a b. c)

@@ -0,0 +1,8 @@+-- @shouldFailWith CannotDeriveNewtypeForData+module CannotDeriveNewtypeForData where++import Data.Newtype++data Test = Test String++derive instance newtypeTest :: Newtype Test _

@@ -1,4 +1,4 @@--- @shouldFailWith CannotApplyFunction+-- @shouldFailWith TypesDoNotUnify -- TODO: Check that this does not produce a "function composition is (<<<)" -- suggestion. 

@@ -0,0 +1,8 @@+-- @shouldFailWith InvalidNewtypeInstance+module Main where++import Prelude++data X = X++derive newtype instance showX :: Show X

@@ -0,0 +1,8 @@+-- @shouldFailWith InvalidNewtypeInstance+module Main where++import Prelude++data X a = X a a++derive newtype instance showX :: Show a => Show (X a)

@@ -0,0 +1,8 @@+-- @shouldFailWith InvalidNewtypeInstance+module Main where++import Prelude++class Nullary++derive newtype instance nullary :: Nullary

@@ -0,0 +1,8 @@+-- @shouldFailWith InvalidNewtypeInstance+module Main where++import Prelude++data X = X | Y++derive newtype instance showX :: Show X

@@ -0,0 +1,8 @@+-- @shouldFailWith NonWildcardNewtypeInstance+module NonWildcardNewtypeInstance where++import Data.Newtype++data Test = Test String++derive instance newtypeTest :: Newtype Test String

@@ -1,8 +1,7 @@--- @shouldFailWith CannotApplyFunction+-- @shouldFailWith TypesDoNotUnify module Main where  import Prelude  main = do   (true `not` _)-

@@ -12,4 +12,3 @@   f a = a  test = f (Foo "" 0)-

@@ -0,0 +1,18 @@+-- @shouldFailWith NoInstanceFound++module Main where++import Prelude+import Control.Monad.Eff (Eff)+import Control.Monad.Eff.Console (log)++newtype MyType a = MyType a++instance cannotShowFunctions :: Fail ("Don't want to show " <> TypeString (MyType a) <> " because.") => Show (MyType a) where+  show _ = "unreachable"++infixl 6 type TypeConcat as <>++main :: Eff _ _+main = do+  log $ show (MyType 2)

@@ -1,4 +1,4 @@--- @shouldFailWith ErrorParsingModule+-- @shouldFailWith InvalidInstanceHead module TypeWildcards where  import Prelude@@ -7,4 +7,3 @@  instance showFoo :: Show (Foo _) where   show Foo = "Foo"-

@@ -1,22 +0,0 @@--- @shouldFailWith NoInstanceFound--- See issue #390.--- TODO: Improve this error.-module Main where--import Prelude--data Z = Z-data S n = S n--data T-data F--class EQ x y b-instance eqT :: EQ x x T-instance eqF :: EQ x y F--foreign import test :: forall a b. (EQ a b T) => a -> b -> a--foreign import anyNat :: forall a. a--test1 = test anyNat (S Z)

@@ -0,0 +1,14 @@+module Main where++import Prelude+import Control.Monad.Eff.Console (log)++fn = _.b.c.d+a = {b:{c:{d:2}}}++d :: Int+d = fn a + a.b.c.d++main = if fn a + a.b.c.d == 4+  then log "Done"+  else log "Fail"

@@ -0,0 +1,9 @@+module Main where++import Control.Monad.Eff.Console++class X a++instance x :: X (Array (Array a)) => X (Array a)++main = log "Done"

@@ -0,0 +1,17 @@+module Main where++import Control.Monad.Eff.Console (log)++import Data.Newtype++newtype Test = Test String++derive instance newtypeTest :: Newtype Test _++t :: Test+t = wrap "hello"++a :: String+a = unwrap t++main = log "Done"

@@ -0,0 +1,32 @@++//: forall e. FVect Z e+exports.fnil = [];++//: forall n e. e -> FVect n e -> FVect (S n) e+exports.fcons = function (hd) {+  return function (tl) {+    return [hd].concat(tl);+  };+};++exports.fappend = function (dict) {+  return function (left) {+    return function (right) {+      return left.concat(right);+    };+  };+};++exports.fflatten = function (dict) {+  return function (v) {+    var accRef = [];+    for (var indexRef = 0; indexRef < v.length; indexRef += 1) {+      accRef = accRef.concat(v[indexRef]);+    }+    return accRef;+  };+};++exports.ftoArray = function (vect) {+  return vect;+};

@@ -0,0 +1,41 @@+-- Taken from https://github.com/LiamGoodacre/purescript-fun-with-fundeps++module Main where++import Control.Monad.Eff.Console (log)++-- Nat : Type+data Z+data S n++type S2 n = S (S n)+type S3 n = S (S2 n)+type S4 n = S (S3 n)+type S5 n = S (S4 n)+type S15 n = S5 (S5 (S5 n))++class NatPlus l r o | l r -> o+instance natPlusZ :: NatPlus Z r r+instance natPlusS :: (NatPlus l r o) => NatPlus (S l) r (S o)++class NatMult l r o | l r -> o+instance natMultZ :: NatMult Z n Z+instance natMultS :: (NatMult m n r, NatPlus n r s) => NatMult (S m) n s++-- Foreign Vect+foreign import data FVect :: * -> * -> *+foreign import fnil :: forall e. FVect Z e+foreign import fcons :: forall n e. e -> FVect n e -> FVect (S n) e+foreign import fappend :: forall l r o e. (NatPlus l r o) => FVect l e -> FVect r e -> FVect o e+foreign import fflatten :: forall f s t o. (NatMult f s o) => FVect f (FVect s t) -> FVect o t+foreign import ftoArray :: forall n e. FVect n e -> Array e++-- should be able to figure these out+fsingleton x = fcons x fnil+fexample = fcons 1 (fsingleton 2) `fappend` fsingleton 3 `fappend` fcons 4 (fsingleton 5)+fexample2 = fexample `fappend` fexample `fappend` fexample+fexample3 = fsingleton fexample `fappend` fsingleton fexample `fappend` fsingleton fexample++fexample4 = fflatten fexample3+ +main = log "Done"

@@ -0,0 +1,21 @@+module Main where++import Control.Monad.Eff.Console (log)++data Nil+data Cons x xs++class Append a b c | a b -> c++instance appendNil :: Append Nil b b++instance appendCons :: Append xs b c => Append (Cons x xs) b (Cons x c)++data Proxy a = Proxy++appendProxy :: forall a b c. Append a b c => Proxy a -> Proxy b -> Proxy c+appendProxy Proxy Proxy = Proxy++test = appendProxy (Proxy :: Proxy (Cons Int Nil)) (Proxy :: Proxy (Cons String Nil))++main = log "Done"

@@ -0,0 +1,140 @@+-- An example to show how we could implement GHC-style Generics using+-- functional dependencies.+--+-- See https://hackage.haskell.org/package/base-4.9.0.0/docs/GHC-Generics.html++module Main where++import Prelude+import Control.Monad.Eff (Eff)+import Control.Monad.Eff.Console (CONSOLE, log, logShow)++-- Representation for types with no constructors+data V1++-- Representation for constructors with no arguments+data U1 = U1++-- Representation for sum types+data Sum a b = Inl a | Inr b++infixr 5 type Sum as +++-- Representation for product types+data Product a b = Product a b++infixr 6 type Product as *++-- Representation for data constructors, with the data constructor name indicated+-- at the type level.+data Ctor (name :: Symbol) a = Ctor a++-- Representation for occurrences of other types in a data type definition.+data K a = K a++-- The Generic class asserts the existence of a type function from "real" types+-- to representation types, and an isomorphism between them.+class Generic a repr | a -> repr where+  to :: a -> repr+  from :: repr -> a++-- We can write an instance for the (recursive) type of lists. Note that these+-- instances would be generated by the compiler ideally.+data List a = Nil | Cons a (List a)++instance genericList :: Generic (List a) (Ctor "Nil" U1 + Ctor "Cons" (K a * K (List a))) where+  to Nil = Inl (Ctor U1)+  to (Cons x xs) = Inr (Ctor (Product (K x) (K xs)))+  from (Inl (Ctor U1)) = Nil+  from (Inr (Ctor (Product (K x) (K xs)))) = Cons x xs++-- We'd like to refect type level strings (for data constructor names) at the value+-- level, so that we can "show" them. Again, these instances would ideally be derived+-- for us.+class KnownSymbol (sym :: Symbol) where+  symbol :: forall proxy. proxy sym -> String++instance knownSymbolNil :: KnownSymbol "Nil" where+  symbol _ = "Nil"++instance knownSymbolCons :: KnownSymbol "Cons" where+  symbol _ = "Cons"++-- A proxy for a type-level string.+data SProxy (sym :: Symbol) = SProxy++-- To write generic functions, we create a corresponding type class, and use the+-- type class machinery to infer the correct function based on the representation+-- type.+class GShow a where+  gShow :: a -> String++-- Now provide instances for GShow for the appropriate representation types.+-- Note: we don't have to implement all instances here.++instance gShowU1 :: GShow U1 where+  gShow _ = ""++instance gShowSum :: (GShow a, GShow b) => GShow (a + b) where+  gShow (Inl a) = gShow a+  gShow (Inr b) = gShow b++instance gShowProduct :: (GShow a, GShow b) => GShow (a * b) where+  gShow (Product a b) = gShow a <> gShow b++instance gShowCtor :: (KnownSymbol ctor, GShow a) => GShow (Ctor ctor a) where+  gShow (Ctor a) = "(" <> symbol (SProxy :: SProxy ctor) <> gShow a <> ")"++instance gShowK :: Show a => GShow (K a) where+  gShow (K a) = " " <> show a++-- Now we can implement a generic show function which uses the GShow instance+-- on the representation type.+genericShow :: forall a repr. (Generic a repr, GShow repr) => a -> String+genericShow x = gShow (to x)++-- Note how the required instance here is Show a, and not Generic a.+-- This allows us to use generic programming on a wider variety of types+-- (including types which contain foreign types) than we can use now.+instance showList :: Show a => Show (List a) where+  show xs = genericShow xs -- (we need to eta expand here to avoid stack overflow+                           -- due to recursion implicit in the instance lookup)++-- Another example: Eq++class GEq a where+  gEq :: a -> a -> Boolean++instance gEqU1 :: GEq U1 where+  gEq _ _ = true++instance gEqSum :: (GEq a, GEq b) => GEq (a + b) where+  gEq (Inl a1) (Inl a2) = gEq a1 a2+  gEq (Inr b1) (Inr b2) = gEq b1 b2+  gEq _ _ = false++instance gEqProduct :: (GEq a, GEq b) => GEq (a * b) where+  gEq (Product a1 b1) (Product a2 b2) = gEq a1 a2 && gEq b1 b2++instance gEqCtor :: (KnownSymbol ctor, GEq a) => GEq (Ctor ctor a) where+  gEq (Ctor a1) (Ctor a2) = gEq a1 a2++instance gEqK :: Eq a => GEq (K a) where+  gEq (K a1) (K a2) = a1 == a2++genericEq :: forall a repr. (Generic a repr, GEq repr) => a -> a -> Boolean+genericEq x y = gEq (to x) (to y)++instance eqList :: Eq a => Eq (List a) where+  eq xs ys = genericEq xs ys++main :: Eff (console :: CONSOLE) Unit+main = do+  logShow (Cons 1 Nil)+  logShow (Cons 1 (Cons 2 Nil))+  logShow (Cons 'x' (Cons 'y' (Cons 'z' Nil)))++  logShow (Cons 1 (Cons 2 Nil) == Cons 1 (Cons 2 Nil))+  logShow (Cons 1 (Cons 2 Nil) == Cons 1 Nil)++  log "Done"

@@ -0,0 +1,39 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.Eff.Console++class Newtype t a | t -> a where+  wrap :: a -> t+  unwrap :: t -> a++instance newtypeMultiplicative :: Newtype (Multiplicative a) a where+  wrap = Multiplicative+  unwrap (Multiplicative a) = a++data Multiplicative a = Multiplicative a++instance semiringMultiplicative :: Semiring a => Semigroup (Multiplicative a) where+  append (Multiplicative a) (Multiplicative b) = Multiplicative (a * b)++data Pair a = Pair a a++foldPair :: forall a s. Semigroup s => (a -> s) -> Pair a -> s+foldPair f (Pair a b) = f a <> f b++ala+  :: forall f t a+   . (Functor f, Newtype t a)+  => (a -> t)+  -> ((a -> t) -> f t)+  -> f a+ala _ f = map unwrap (f wrap)++test = ala Multiplicative foldPair++test1 = ala Multiplicative foldPair (Pair 2 3)++main = do+  logShow (test (Pair 2 3))+  log "Done"

@@ -0,0 +1,30 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.Eff.Console++newtype X = X String++derive newtype instance showX :: Show X++derive newtype instance eqX :: Eq X++derive newtype instance ordX :: Ord X++newtype Y a = Y (Array a)++derive newtype instance showY :: Show (Y String)++class Singleton a b where+  singleton :: a -> b++instance singletonArray :: Singleton a (Array a) where+  singleton x = [x]++derive newtype instance singletonY :: Singleton a (Y a)++main = do+  logShow (X "test")+  logShow (singleton "test" :: Y String)+  log "Done"

@@ -19,8 +19,8 @@   test "32.96176575630599" 32.96176575630599   test "38.47735512322269" 38.47735512322269 -  test "10000000000" 1e10-  test "10000000000" 1.0e10+  test "10000000000.0" 1e10+  test "10000000000.0" 1.0e10   test "0.00001" 1e-5   test "0.00001" 1.0e-5   test "1.5339794352098402e-118" 1.5339794352098402e-118

@@ -3,7 +3,7 @@ import Prelude import Control.Monad.Eff.Console (log) -class T s m where+class T s m | m -> s where   state :: (s -> s) -> m Unit  data S s a = S (s -> { new :: s, ret :: a })

@@ -0,0 +1,26 @@+module Main where++import Prelude++import Control.Monad.Eff (Eff)+import Control.Monad.Eff.Console (CONSOLE, log)++class IsStream el s | s -> el where+  cons :: el -> (Unit -> s) -> s+  uncons :: s -> { head :: el, tail :: s }++data Stream a = Stream a (Unit -> Stream a)++instance streamIsStream :: IsStream a (Stream a) where+  cons x xs = Stream x xs+  uncons (Stream x f) = { head: x, tail: f unit }++test :: forall el s. IsStream el s => s -> s+test s = case uncons s of+           { head, tail } -> cons head \_ -> tail++main :: Eff (console :: CONSOLE) Unit+main = do+  let dones :: Stream String+      dones = cons "Done" \_ -> dones+  log (uncons (test dones)).head

@@ -0,0 +1,25 @@+module Main where++import Control.Monad.Eff.Console (log)++data Z = Z+data S n = S n++data T+data F++class EQ x y b+instance eqT :: EQ x x T+instance eqF :: EQ x y F++test :: forall a b. (EQ a b T) => a -> b -> a+test a _ = a++spin :: forall a b. a -> b+spin a = spin a++-- Expected type: +-- forall t. (EQ t (S Z) T) => t+test1 = test (spin 1) (S Z)++main = log "Done"

@@ -0,0 +1,23 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.Eff.Console++-- Until the functional dependency gets added to purescript-eff, +-- we need this here.+class Monad m <= MonadEff eff m | m -> eff where+  liftEff :: forall a. Eff eff a -> m a++instance monadEffEff :: MonadEff eff (Eff eff) where+  liftEff = id++-- This should generate a warning with the correct inferred type.+test :: forall m. MonadEff _ m => m Unit+test = liftEff $ log "Done"++test1 :: Eff _ Unit+test1 = liftEff $ log "Done"++main :: forall eff. Eff (console :: CONSOLE | eff) Unit+main = test

@@ -18,13 +18,16 @@  module Main where +import Control.Applicative (optional) import Control.Monad (unless)  import Data.List (intercalate,nub,sort) import Data.Foldable (for_) import Data.Version (showVersion)+import Data.Monoid ((<>)) -import Options.Applicative+import Options.Applicative (Parser)+import qualified Options.Applicative as Opts import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>)) import System.FilePath.Glob (glob)@@ -40,7 +43,7 @@   , hierarchyOutput :: Maybe FilePath   } -newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) ((P.ProperName 'P.ClassName), (P.ProperName 'P.ClassName)) }+newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) (P.ProperName 'P.ClassName, P.ProperName 'P.ClassName) }   deriving Eq  instance Show SuperMap where@@ -83,33 +86,33 @@       exitSuccess  superClasses :: P.Declaration -> [SuperMap]-superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =+superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _ _) =   fmap (\(P.Constraint (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers-superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]+superClasses (P.TypeClassDeclaration sub _ _ _ _) = [SuperMap (Left sub)] superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl superClasses _ = []  inputFile :: Parser FilePath-inputFile = strArgument $-     metavar "FILE"-  <> value "main.purs"-  <> showDefault-  <> help "The input file to generate a hierarchy from"+inputFile = Opts.strArgument $+     Opts.metavar "FILE"+  <> Opts.value "main.purs"+  <> Opts.showDefault+  <> Opts.help "The input file to generate a hierarchy from"  outputFile :: Parser (Maybe FilePath)-outputFile = optional . strOption $-     short 'o'-  <> long "output"-  <> help "The output directory"+outputFile = optional . Opts.strOption $+     Opts.short 'o'+  <> Opts.long "output"+  <> Opts.help "The output directory"  pscOptions :: Parser HierarchyOptions pscOptions = HierarchyOptions <$> inputFile                               <*> outputFile  main :: IO ()-main = execParser opts >>= compile+main = Opts.execParser opts >>= compile   where-  opts        = info (helper <*> pscOptions) infoModList-  infoModList = fullDesc <> headerInfo <> footerInfo-  headerInfo  = header   "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"-  footerInfo  = footer $ "hierarchy " ++ showVersion Paths.version+  opts        = Opts.info (Opts.helper <*> pscOptions) infoModList+  infoModList = Opts.fullDesc <> headerInfo <> footerInfo+  headerInfo  = Opts.header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"+  footerInfo  = Opts.footer $ "hierarchy " ++ showVersion Paths.version

@@ -8,6 +8,7 @@  import Data.Traversable (for) import Data.Version (showVersion)+import Data.Monoid ((<>))  import Control.Applicative import Control.Monad@@ -24,7 +25,8 @@  import Language.PureScript.Bundle -import Options.Applicative as Opts+import Options.Applicative (Parser, ParseError (..))+import qualified Options.Applicative as Opts  import qualified Paths_purescript as Paths @@ -64,41 +66,41 @@                   <*> namespace   where   inputFile :: Parser FilePath-  inputFile = strArgument $-       metavar "FILE"-    <> help "The input .js file(s)"+  inputFile = Opts.strArgument $+       Opts.metavar "FILE"+    <> Opts.help "The input .js file(s)"    outputFile :: Parser FilePath-  outputFile = strOption $-       short 'o'-    <> long "output"-    <> help "The output .js file"+  outputFile = Opts.strOption $+       Opts.short 'o'+    <> Opts.long "output"+    <> Opts.help "The output .js file"    entryPoint :: Parser String-  entryPoint = strOption $-       short 'm'-    <> long "module"-    <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."+  entryPoint = Opts.strOption $+       Opts.short 'm'+    <> Opts.long "module"+    <> Opts.help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."    mainModule :: Parser String-  mainModule = strOption $-       long "main"-    <> help "Generate code to run the main method in the specified module."+  mainModule = Opts.strOption $+       Opts.long "main"+    <> Opts.help "Generate code to run the main method in the specified module."    namespace :: Parser String-  namespace = strOption $-       short 'n'-    <> long "namespace"+  namespace = Opts.strOption $+       Opts.short 'n'+    <> Opts.long "namespace"     <> Opts.value "PS"-    <> showDefault-    <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."+    <> Opts.showDefault+    <> Opts.help "Specify the namespace that PureScript modules will be exported to when running in the browser."  -- | Make it go. main :: IO () main = do   hSetEncoding stdout utf8   hSetEncoding stderr utf8-  opts <- execParser (info (version <*> helper <*> options) infoModList)+  opts <- Opts.execParser (Opts.info (version <*> Opts.helper <*> options) infoModList)   output <- runExceptT (app opts)   case output of     Left err -> do@@ -111,9 +113,10 @@           writeFile outputFile js         Nothing -> putStrLn js   where-  infoModList = fullDesc <> headerInfo <> footerInfo-  headerInfo  = header   "psc-bundle - Bundles compiled PureScript modules for the browser"-  footerInfo  = footer $ "psc-bundle " ++ showVersion Paths.version+  infoModList = Opts.fullDesc <> headerInfo <> footerInfo+  headerInfo  = Opts.header   "psc-bundle - Bundles compiled PureScript modules for the browser"+  footerInfo  = Opts.footer $ "psc-bundle " ++ showVersion Paths.version    version :: Parser (a -> a)-  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden+  version = Opts.abortOption (InfoMsg (showVersion Paths.version)) $+    Opts.long "version" <> Opts.help "Show the version number" <> Opts.hidden

@@ -13,6 +13,6 @@         names (P.TypeDeclaration ident _) = [P.showIdent ident]         names (P.ExternDeclaration ident _) = [P.showIdent ident]         names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]-        names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]+        names (P.TypeClassDeclaration name _ _ _ _) = [P.runProperName name]         names (P.TypeInstanceDeclaration name _ _ _ _) = [P.showIdent name]         names _ = []

@@ -8,8 +8,10 @@ import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text.IO          as T import           Data.Version          (showVersion)+import           Data.Monoid           ((<>)) import           Network-import           Options.Applicative+import           Options.Applicative   (ParseError (..))+import qualified Options.Applicative   as Opts import           System.Exit import           System.IO @@ -21,15 +23,16 @@  main :: IO () main = do-    Options port <- execParser opts+    Options port <- Opts.execParser opts     client port   where     parser =         Options <$>         (PortNumber . fromIntegral <$>-         option auto (long "port" <> short 'p' <> value (4242 :: Integer)))-    opts = info (version <*> helper <*> parser) mempty-    version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden+         Opts.option Opts.auto (Opts.long "port" <> Opts.short 'p' <> Opts.value (4242 :: Integer)))+    opts = Opts.info (version <*> Opts.helper <*> parser) mempty+    version = Opts.abortOption (InfoMsg (showVersion Paths.version)) $+      Opts.long "version" <> Opts.help "Show the version number" <> Opts.hidden  client :: PortID -> IO () client port = do

@@ -38,7 +38,8 @@ import           Network.BSD                       (getProtocolNumber) import           Network.Socket                    hiding (PortNumber, Type,                                                     sClose)-import           Options.Applicative               hiding ((<>))+import           Options.Applicative               (ParseError (..))+import qualified Options.Applicative               as Opts import           System.Directory import           System.FilePath import           System.IO                         hiding (putStrLn, print)@@ -55,7 +56,7 @@     sClose     (\sock -> do       setSocketOption sock ReuseAddr 1-      bindSocket sock (SockAddrInet port localhost)+      bind sock (SockAddrInet port localhost)       listen sock maxListenQueue       pure sock) @@ -70,7 +71,7 @@  main :: IO () main = do-  Options dir globs outputPath port noWatch debug <- execParser opts+  Options dir globs outputPath port noWatch debug <- Opts.execParser opts   maybe (pure ()) setCurrentDirectory dir   ideState <- newTVarIO emptyIdeState   cwd <- getCurrentDirectory@@ -91,17 +92,17 @@   where     parser =       Options-        <$> optional (strOption (long "directory" `mappend` short 'd'))-        <*> many (argument str (metavar "Source GLOBS..."))-        <*> strOption (long "output-directory" `mappend` value "output/")+        <$> optional (Opts.strOption (Opts.long "directory" `mappend` Opts.short 'd'))+        <*> many (Opts.argument Opts.str (Opts.metavar "Source GLOBS..."))+        <*> Opts.strOption (Opts.long "output-directory" `mappend` Opts.value "output/")         <*> (fromIntegral <$>-             option auto (long "port" `mappend` short 'p' `mappend` value (4242 :: Integer)))-        <*> switch (long "no-watch")-        <*> switch (long "debug")-    opts = info (version <*> helper <*> parser) mempty-    version = abortOption+             Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer)))+        <*> Opts.switch (Opts.long "no-watch")+        <*> Opts.switch (Opts.long "debug")+    opts = Opts.info (version <*> Opts.helper <*> parser) mempty+    version = Opts.abortOption       (InfoMsg (showVersion Paths.version))-      (long "version" `mappend` help "Show the version number")+      (Opts.long "version" `mappend` Opts.help "Show the version number")  startServer :: PortNumber -> IdeEnvironment -> IO () startServer port env = withSocketsDo $ do

@@ -4,8 +4,10 @@ import Data.Version (Version(..), showVersion) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Monoid ((<>)) -import Options.Applicative hiding (str)+import Options.Applicative (Parser, ParseError (..))+import qualified Options.Applicative as Opts  import System.IO (hSetEncoding, stderr, stdout, utf8) @@ -14,9 +16,9 @@ import Language.PureScript.Publish.ErrorsWarnings  dryRun :: Parser Bool-dryRun = switch $-     long "dry-run"-  <> help "Produce no output, and don't require a tagged version to be checked out."+dryRun = Opts.switch $+     Opts.long "dry-run"+  <> Opts.help "Produce no output, and don't require a tagged version to be checked out."  dryRunOptions :: PublishOptions dryRunOptions = defaultPublishOptions@@ -29,15 +31,16 @@ main = do   hSetEncoding stdout utf8   hSetEncoding stderr utf8-  execParser opts >>= publish+  Opts.execParser opts >>= publish   where-  opts        = info (version <*> helper <*> dryRun) infoModList-  infoModList = fullDesc <> headerInfo <> footerInfo-  headerInfo  = header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"-  footerInfo  = footer $ "psc-publish " ++ showVersion Paths.version+  opts        = Opts.info (version <*> Opts.helper <*> dryRun) infoModList+  infoModList = Opts.fullDesc <> headerInfo <> footerInfo+  headerInfo  = Opts.header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"+  footerInfo  = Opts.footer $ "psc-publish " ++ showVersion Paths.version    version :: Parser (a -> a)-  version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden+  version = Opts.abortOption (InfoMsg (showVersion Paths.version)) $+    Opts.long "version" <> Opts.help "Show the version number" <> Opts.hidden  publish :: Bool -> IO () publish isDryRun =

@@ -79,11 +79,11 @@ globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath] globWarningOnMisses warn = concatMapM globWithWarning   where-  globWithWarning pattern = do-    paths <- glob pattern-    when (null paths) $ warn pattern+  globWithWarning pattern' = do+    paths <- glob pattern'+    when (null paths) $ warn pattern'     return paths-  concatMapM f = liftM concat . mapM f+  concatMapM f = fmap concat . mapM f  readInput :: [FilePath] -> IO [(FilePath, String)] readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile@@ -143,7 +143,12 @@      long "source-maps"   <> help "Generate source maps" +dumpCoreFn :: Parser Bool+dumpCoreFn = switch $+     long "dump-corefn"+  <> help "Dump the (functional) core representation of the compiled code at output/*/corefn.json" + options :: Parser P.Options options = P.Options <$> noTco                     <*> noMagicDo@@ -152,6 +157,7 @@                     <*> verboseErrors                     <*> (not <$> comments)                     <*> sourceMaps+                    <*> dumpCoreFn  pscMakeOptions :: Parser PSCMakeOptions pscMakeOptions = PSCMakeOptions <$> many inputFile

@@ -207,7 +207,7 @@                 -- With many connected clients, all but one of                 -- these attempts will fail.                 tryPutMVar resultVar (unpack result)-              Reload -> do+              Reload ->                 WS.sendTextData conn ("reload" :: Text)          shutdownHandler :: IO () -> IO ()@@ -278,7 +278,7 @@         Left err -> do           putStrLn (unlines (Bundle.printErrorMessage err))           exitFailure-        Right js -> do+        Right js ->           atomically $ writeTVar (browserBundleJS state) (Just js)      reload :: BrowserState -> IO ()@@ -335,7 +335,7 @@           (externs, env) <- ExceptT . runMake . make $ modules           return (modules, externs, env)         case psciBackend of-          Backend setup eval reload (shutdown :: state -> IO ()) -> do+          Backend setup eval reload (shutdown :: state -> IO ()) ->             case e of               Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure               Right (modules, externs, env) -> do

@@ -1,5 +1,5 @@ name: purescript-version: 0.9.3+version: 0.10.0 cabal-version: >=1.8 build-type: Simple license: MIT@@ -100,7 +100,7 @@  library     build-depends: base >=4.8 && <5,-                   aeson >= 0.8 && < 0.12,+                   aeson >= 0.8 && < 1.1,                    aeson-better-errors >= 0.8,                    ansi-terminal >= 0.6.2 && < 0.7,                    base-compat >=0.6.0,@@ -109,6 +109,7 @@                    bytestring -any,                    containers -any,                    clock -any,+                   data-ordlist >= 0.4.7.0,                    directory >= 1.2,                    dlist -any,                    edit-distance -any,@@ -116,7 +117,7 @@                    fsnotify >= 0.2.1,                    Glob >= 0.7 && < 0.8,                    haskeline >= 0.7.0.0,-                   http-client >= 0.4.30 && <0.5,+                   http-client >= 0.4.30 && <0.6,                    http-types -any,                    language-javascript == 0.6.*,                    lifted-base >= 0.2.3 && < 0.2.4,@@ -179,6 +180,7 @@                      Language.PureScript.CoreFn.Meta                      Language.PureScript.CoreFn.Module                      Language.PureScript.CoreFn.Traversals+                     Language.PureScript.CoreFn.ToJSON                      Language.PureScript.Comments                      Language.PureScript.Environment                      Language.PureScript.Errors@@ -315,7 +317,7 @@ executable psc     build-depends: base >=4 && <5,                    purescript -any,-                   aeson >= 0.8 && < 0.12,+                   aeson >= 0.8 && < 1.1,                    ansi-terminal >= 0.6.2 && < 0.7,                    base-compat >=0.6.0,                    bytestring -any,@@ -440,7 +442,7 @@   other-modules:       Paths_purescript   other-extensions:   build-depends:       base >=4 && <5,-                       aeson >= 0.8 && < 0.12,+                       aeson >= 0.8 && < 1.1,                        bytestring -any,                        purescript -any,                        base-compat >=0.6.0,@@ -520,5 +522,6 @@                    Language.PureScript.Ide.ReexportsSpec                    Language.PureScript.Ide.SourceFile.IntegrationSpec                    Language.PureScript.Ide.SourceFileSpec+                   Language.PureScript.Ide.StateSpec     buildable: True     hs-source-dirs: tests

@@ -7,6 +7,7 @@  import Control.Monad.Supply import Control.Monad.State+import Control.Monad.Writer  class Monad m => MonadSupply m where   fresh :: m Integer@@ -18,6 +19,9 @@     return n  instance MonadSupply m => MonadSupply (StateT s m) where+  fresh = lift fresh++instance (Monoid w, MonadSupply m) => MonadSupply (WriterT w m) where   fresh = lift fresh  freshName :: MonadSupply m => m String

@@ -77,6 +77,7 @@   | NoInstanceFound Constraint   | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]   | CannotDerive (Qualified (ProperName 'ClassName)) [Type]+  | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [Type]   | CannotFindDerivingType (ProperName 'TypeName)   | DuplicateLabel String (Maybe Expr)   | DuplicateValueDeclaration Ident@@ -89,7 +90,6 @@   | ExprDoesNotHaveType Expr Type   | PropertyIsMissing String   | AdditionalProperty String-  | CannotApplyFunction Type Expr   | TypeSynonymInstance   | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]   | InvalidNewtype (ProperName 'TypeName)@@ -108,8 +108,8 @@   | ImportHidingModule ModuleName   | UnusedImport ModuleName   | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]-  | UnusedDctorImport (ProperName 'TypeName)-  | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]+  | 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@@ -123,6 +123,8 @@   | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)   | DeprecatedRequirePath   | CannotGeneralizeRecursiveFunction Ident Type+  | CannotDeriveNewtypeForData (ProperName 'TypeName)+  | NonWildcardNewtypeInstance (ProperName 'TypeName)   deriving (Show)  -- | Error message hints, providing more detailed information about failure.@@ -348,7 +350,7 @@   -- |   -- A type class declaration (name, argument, implies, member declarations)   ---  | TypeClassDeclaration (ProperName 'ClassName) [(String, Maybe Kind)] [Constraint] [Declaration]+  | TypeClassDeclaration (ProperName 'ClassName) [(String, Maybe Kind)] [Constraint] [FunctionalDependency] [Declaration]   -- |   -- A type instance declaration (name, dependencies, class name, instance types, member   -- declarations)@@ -374,10 +376,15 @@  -- | The members of a type class instance declaration data TypeInstanceBody-  -- | This is a derived instance   = DerivedInstance-  -- | This is a regular (explicit) instance+  -- ^ 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@@ -385,8 +392,8 @@  -- | A traversal for TypeInstanceBody traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody-traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds+traverseTypeInstanceBody _ other = pure other  -- | -- Test if a declaration is a value declaration@@ -497,12 +504,9 @@   --   | Parens Expr   -- |-  -- A record property getter (e.g. `_.x`). This will be removed during-  -- desugaring and expanded into a lambda that reads a property from a record.-  ---  | ObjectGetter String-  -- |-  -- An record property accessor expression+  -- 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 String Expr   -- |@@ -573,7 +577,7 @@   -- |   -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking   ---  | SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]+  | DeferredDictionary (Qualified (ProperName 'ClassName)) [Type]   -- |   -- A placeholder for an anonymous function argument   --

@@ -133,7 +133,7 @@   matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'   matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'   matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'-  matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'+  matches (TypeClassDeclaration ident _ _ _ _) (TypeClassRef ident') = ident == ident'   matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'   matches (TypeFixityDeclaration _ _ op) (TypeOpRef op') = op == op'   matches (PositionedDeclaration _ _ d) r = d `matches` r

@@ -34,7 +34,7 @@   f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))   f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))   f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))-  f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))+  f' (TypeClassDeclaration name args implies deps ds) = f (TypeClassDeclaration name args implies deps (map f' ds))   f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))   f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))   f' other = f other@@ -101,7 +101,7 @@   f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds   f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h' <=< h) bs <*> eitherM (traverse (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val   f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds-  f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> traverse (f' <=< f) ds+  f' (TypeClassDeclaration name args implies deps ds) = TypeClassDeclaration name args implies deps <$> traverse (f' <=< f) ds   f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds   f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')   f' other = f other@@ -168,7 +168,7 @@   f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f   f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> traverse h' bs <*> eitherM (traverse (pairM g' g')) g' val) >>= f   f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f-  f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> traverse f' ds) >>= f+  f' (TypeClassDeclaration name args implies deps ds) = (TypeClassDeclaration name args implies deps <$> traverse f' ds) >>= f   f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f   f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f   f' other = f other@@ -240,7 +240,7 @@   f' d@(ValueDeclaration _ _ bs (Right val)) = foldl (<>) (f d) (map h' bs) <> g' val   f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)   f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)-  f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)+  f' d@(TypeClassDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)   f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)   f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1   f' d = f d@@ -314,7 +314,7 @@   f' s (ValueDeclaration _ _ bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val   f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)   f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)-  f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)+  f' s (TypeClassDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)   f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)   f' s (PositionedDeclaration _ _ d1) = f'' s d1   f' _ _ = r0@@ -395,7 +395,7 @@   f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds   f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h'' s) bs <*> eitherM (traverse (pairM (g'' s) (g'' s))) (g'' s) val   f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds-  f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> traverse (f'' s) ds+  f' s (TypeClassDeclaration name args implies deps ds) = TypeClassDeclaration name args implies deps <$> traverse (f'' s) ds   f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds   f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1   f' _ other = return other@@ -482,7 +482,7 @@   f' s (BindingGroupDeclaration ds) =     let s' = S.union s (S.fromList (map (\(name, _, _) -> name) ds))     in foldMap (\(_, _, val) -> g'' s' val) ds-  f' s (TypeClassDeclaration _ _ _ ds) = foldMap (f'' s) ds+  f' s (TypeClassDeclaration _ _ _ _ ds) = foldMap (f'' s) ds   f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds   f' s (PositionedDeclaration _ _ d) = f'' s d   f' _ _ = mempty@@ -576,13 +576,13 @@   where   forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)   forDecls (ExternDeclaration _ ty) = f ty-  forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . constraintArgs) implies)+  forDecls (TypeClassDeclaration _ _ implies _ _) = mconcat (concatMap (map f . constraintArgs) implies)   forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . constraintArgs) cs) `mappend` mconcat (map f tys)   forDecls (TypeSynonymDeclaration _ _ ty) = f ty   forDecls (TypeDeclaration _ ty) = f ty   forDecls _ = mempty    forValues (TypeClassDictionary c _ _) = mconcat (map f (constraintArgs c))-  forValues (SuperClassDictionary _ tys) = mconcat (map f tys)+  forValues (DeferredDictionary _ tys) = mconcat (map f tys)   forValues (TypedValue _ _ ty) = f ty   forValues _ = mempty

@@ -43,6 +43,8 @@   | UnableToParseModule String   | UnsupportedExport   | ErrorInModule ModuleIdentifier ErrorMessage+  | MissingEntryPoint String+  | MissingMainModule String   deriving (Show)  -- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.@@ -125,8 +127,14 @@   : ""   : map ("  " ++) (printErrorMessage e)   where-  displayIdentifier (ModuleIdentifier name ty) =-    name ++ " (" ++ showModuleType ty ++ ")"+    displayIdentifier (ModuleIdentifier name ty) =+      name ++ " (" ++ showModuleType ty ++ ")"+printErrorMessage (MissingEntryPoint mName) =+  [ "Couldn't find a CommonJS module for the specified entry point: " ++ mName+  ]+printErrorMessage (MissingMainModule mName) =+  [ "Couldn't find a CommonJS module for the specified main module: " ++ mName+  ]  -- | Calculate the ModuleIdentifier which a require(...) statement imports. checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier@@ -256,7 +264,7 @@     = pure (Member stmt exported name decl [])   toModuleElement stmt     | Just props <- matchExportsAssignment stmt-    = (ExportsList <$> traverse toExport (trailingCommaList props))+    = ExportsList <$> traverse toExport (trailingCommaList props)     where       toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key])       toExport (JSPropertyNameandValue name _ [val]) =@@ -524,7 +532,7 @@   indent :: [JSStatement] -> [JSStatement]   indent = everywhere (mkT squash)     where-    squash JSNoAnnot = (JSAnnot (TokenPn 0 0 2) [])+    squash JSNoAnnot = JSAnnot (TokenPn 0 0 2) []     squash (JSAnnot pos ann) = JSAnnot (keepCol pos) (map splat ann)      splat (CommentA pos s) = CommentA (keepCol pos) s@@ -571,15 +579,15 @@                   (JSSemi JSNoAnnot)     ]     where-      lfHead (h:t) = (addAnn (WhiteSpace tokenPosnEmpty "\n  ") h) : t+      lfHead (h:t) = addAnn (WhiteSpace tokenPosnEmpty "\n  ") h : t       lfHead x = x        addAnn :: CommentAnnotation -> JSStatement -> JSStatement       addAnn a (JSExpressionStatement (JSStringLiteral ann s) _) =-        (JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot))+        JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot)       addAnn _ x = x -      appendAnn a JSNoAnnot = (JSAnnot tokenPosnEmpty [a])+      appendAnn a JSNoAnnot = JSAnnot tokenPosnEmpty [a]       appendAnn a (JSAnnot _ anns) = JSAnnot tokenPosnEmpty (a:anns ++ [WhiteSpace tokenPosnEmpty "  "])    runMain :: String -> [JSStatement]@@ -609,6 +617,10 @@        -> String -- ^ The namespace (e.g. PS).        -> m String bundle inputStrs entryPoints mainModule namespace = do+  forM_ mainModule $ \mname ->+    when (mname `notElem` map (moduleName . fst) inputStrs) (throwError (MissingMainModule mname))+  forM_ entryPoints $ \mIdent ->+    when (mIdent `notElem` map fst inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))   input <- forM inputStrs $ \(ident, js) -> do                 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)                 return (ident, ast)

@@ -15,7 +15,7 @@ import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Supply.Class -import Data.List ((\\), delete, intersect)+import Data.List ((\\), delete, intersect, nub) import Data.Maybe (isNothing, fromMaybe) import qualified Data.Foldable as F import qualified Data.Map as M@@ -51,7 +51,7 @@   rethrow (addHint (ErrorInModule mn)) $ do     let usedNames = concatMap getNames decls     let mnLookup = renameImports usedNames imps-    jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ map snd imps+    jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ nub $ map snd imps     let decls' = renameModules mnLookup decls     jsDecls <- mapM bindToJs decls'     optimized <- T.traverse (T.traverse optimize) jsDecls@@ -89,7 +89,7 @@       in if mn' /= mn && mni `elem` used          then let newName = freshModuleName 1 mn' used               in go (M.insert mn' (ann, newName) acc) (Ident (runModuleName newName) : used) mns'-         else go (M.insert mn' (ann, mn') acc) (mni : used) mns'+         else go (M.insert mn' (ann, mn') acc) used mns'     go acc _ [] = acc      freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName@@ -367,7 +367,7 @@   -- binder.   --   binderToJs' :: String -> [JS] -> Binder Ann -> m [JS]-  binderToJs' _ done (NullBinder{}) = return done+  binderToJs' _ done NullBinder{} = return done   binderToJs' varName done (LiteralBinder _ l) =     literalToBinderJS varName done l   binderToJs' varName done (VarBinder _ ident) =

@@ -34,7 +34,6 @@ import Language.PureScript.CodeGen.JS.Optimizer.TCO import Language.PureScript.CodeGen.JS.Optimizer.Unused import Language.PureScript.Options-import qualified Language.PureScript.Constants as C  -- | -- Apply a series of optimizer passes to simplified Javascript code@@ -49,11 +48,6 @@   opts <- ask   js' <- untilFixedPoint (inlineFnComposition . tidyUp . applyAll     [ inlineCommonValues-    , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp Nothing f [x]-    , inlineOperator (C.dataFunction, C.apply) $ \f x -> JSApp Nothing f [x]-    , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp Nothing f [x]-    , inlineOperator (C.dataFunction, C.applyFlipped) $ \x f -> JSApp Nothing f [x]-    , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip (JSIndexer Nothing)     , inlineCommonOperators     ]) js   untilFixedPoint (return . tidyUp) . tco opts . magicDo opts $ js'

@@ -4,7 +4,6 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner   ( inlineVariables   , inlineCommonValues-  , inlineOperator   , inlineCommonOperators   , inlineFnComposition   , etaConvert@@ -100,13 +99,13 @@   fnSubtract = (C.dataRing, C.sub)   intOp ss op x y = JSBinary ss BitwiseOr (JSBinary ss op x y) (JSNumericLiteral ss (Left 0)) -inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS-inlineOperator (m, op) f = everywhereOnJS convert+inlineNonClassFunction :: (String, String) -> (JS -> JS -> JS) -> JS -> JS+inlineNonClassFunction (m, op) f = everywhereOnJS convert   where   convert :: JS -> JS   convert (JSApp _ (JSApp _ op' [x]) [y]) | isOp op' = f x y   convert other = other-  isOp (JSIndexer _ (JSStringLiteral _ op') (JSVar _ m')) = m == m' && op == op'+  isOp (JSAccessor _ op' (JSVar _ m')) = m == m' && op == op'   isOp _ = False  inlineCommonOperators :: JS -> JS@@ -167,6 +166,10 @@   , binary' C.dataIntBits C.shr ShiftRight   , binary' C.dataIntBits C.zshr ZeroFillShiftRight   , unary'  C.dataIntBits C.complement BitwiseNot++  , inlineNonClassFunction (C.dataFunction, C.apply) $ \f x -> JSApp Nothing f [x]+  , inlineNonClassFunction (C.dataFunction, C.applyFlipped) $ \x f -> JSApp Nothing f [x]+  , inlineNonClassFunction (C.dataArrayUnsafe, C.unsafeIndex) $ flip (JSIndexer Nothing)   ] ++   [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]   where

@@ -72,7 +72,7 @@     [NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]   declToCoreFn ss _   (A.BindingGroupDeclaration ds) =     [Rec $ map (\(name, _, e) -> ((ssA ss, name), exprToCoreFn ss [] Nothing e)) ds]-  declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =+  declToCoreFn ss com (A.TypeClassDeclaration name _ supers _ members) =     [NonRec (ssA ss) (properToIdent name) $ mkTypeClassConstructor ss com supers members]   declToCoreFn _  com (A.PositionedDeclaration ss com1 d) =     declToCoreFn (Just ss) (com ++ com1) d

@@ -0,0 +1,116 @@+-- |+-- Dump the core functional representation in JSON format for consumption+-- by third-party code generators+--+module Language.PureScript.CoreFn.ToJSON+  ( moduleToJSON+  ) where++import Prelude.Compat++import Data.Aeson+import Data.Version (Version, showVersion)+import Data.Text (pack)++import Language.PureScript.AST.Literals+import Language.PureScript.CoreFn+import Language.PureScript.Names++literalToJSON :: (a -> Value) -> Literal a -> Value+literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)+literalToJSON _ (NumericLiteral (Right n)) = toJSON ("NumberLiteral", n)+literalToJSON _ (StringLiteral s) = toJSON ("StringLiteral", s)+literalToJSON _ (CharLiteral c) = toJSON ("CharLiteral", c)+literalToJSON _ (BooleanLiteral b) = toJSON ("BooleanLiteral", b)+literalToJSON t (ArrayLiteral xs) = toJSON ("ArrayLiteral", map t xs)+literalToJSON t (ObjectLiteral xs) = toJSON ("ObjectLiteral", recordToJSON t xs)++identToJSON :: Ident -> Value+identToJSON = toJSON . runIdent++properNameToJSON :: ProperName a -> Value+properNameToJSON = toJSON . runProperName++qualifiedToJSON :: (a -> String) -> Qualified a -> Value+qualifiedToJSON f = toJSON . showQualified f++moduleNameToJSON :: ModuleName -> Value+moduleNameToJSON = toJSON . runModuleName++moduleToJSON :: Version -> Module a -> Value+moduleToJSON v m = object [ pack "imports"   .= map (moduleNameToJSON . snd) (moduleImports m)+                          , pack "exports"   .= map identToJSON (moduleExports m)+                          , pack "foreign"   .= map (identToJSON . fst) (moduleForeign m)+                          , pack "decls"     .= map bindToJSON (moduleDecls m)+                          , pack "builtWith" .= toJSON (showVersion v)+                          ]++bindToJSON :: Bind a -> Value+bindToJSON (NonRec _ n e) = object [ pack (runIdent n) .= exprToJSON e ]+bindToJSON (Rec bs) = object $ map (\((_, n), e) -> pack (runIdent n) .= exprToJSON e) bs++recordToJSON :: (a -> Value) -> [(String, a)] -> Value+recordToJSON f = object . map (\(label, a) -> pack label .= f a)++exprToJSON :: Expr a -> Value+exprToJSON (Var _ i)              = toJSON ( "Var"+                                           , qualifiedToJSON runIdent i+                                           )+exprToJSON (Literal _ l)          = toJSON ( "Literal"+                                           , literalToJSON (exprToJSON) l+                                           )+exprToJSON (Constructor _ d c is) = toJSON ( "Constructor"+                                           , properNameToJSON d+                                           , properNameToJSON c+                                           , map identToJSON is+                                           )+exprToJSON (Accessor _ f r)       = toJSON ( "Accessor"+                                           , f+                                           , exprToJSON r+                                           )+exprToJSON (ObjectUpdate _ r fs)  = toJSON ( "ObjectUpdate"+                                           , exprToJSON r+                                           , recordToJSON exprToJSON fs+                                           )+exprToJSON (Abs _ p b)            = toJSON ( "Abs"+                                           , identToJSON p+                                           , exprToJSON b+                                           )+exprToJSON (App _ f x)            = toJSON ( "App"+                                           , exprToJSON f+                                           , exprToJSON x+                                           )+exprToJSON (Case _ ss cs)         = toJSON ( "Case"+                                           , map exprToJSON ss+                                           , map caseAlternativeToJSON cs+                                           )+exprToJSON (Let _ bs e)           = toJSON ( "Let"+                                           , map bindToJSON bs+                                           , exprToJSON e+                                           )++caseAlternativeToJSON :: CaseAlternative a -> Value+caseAlternativeToJSON (CaseAlternative bs r') =+  toJSON [ toJSON (map binderToJSON bs)+         , case r' of+             Left rs -> toJSON $ map (\(g, e) -> (exprToJSON g, exprToJSON e)) rs+             Right r -> exprToJSON r+         ]++binderToJSON :: Binder a -> Value+binderToJSON (VarBinder _ v)              = toJSON ( "VarBinder"+                                                   , identToJSON v+                                                   )+binderToJSON (NullBinder _)               = toJSON "NullBinder"+binderToJSON (LiteralBinder _ l)          = toJSON ( "LiteralBinder"+                                                   , literalToJSON binderToJSON l+                                                   )+binderToJSON (ConstructorBinder _ d c bs) = toJSON ( "ConstructorBinder"+                                                   , qualifiedToJSON runProperName d+                                                   , qualifiedToJSON runProperName c+                                                   , map binderToJSON bs+                                                   )+binderToJSON (NamedBinder _ n b)          = toJSON ( "NamedBinder"+                                                   , identToJSON n+                                                   , binderToJSON b+                                                   )

@@ -81,7 +81,7 @@ getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name) getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name) getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)-getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (P.runProperName name)+getDeclarationTitle (P.TypeClassDeclaration name _ _ _ _) = Just (P.runProperName name) getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name) getDeclarationTitle (P.TypeFixityDeclaration _ _ op) = Just ("type " ++ P.showOp op) getDeclarationTitle (P.ValueFixityDeclaration _ _ op) = Just (P.showOp op)@@ -121,7 +121,7 @@   basicDeclaration title (ExternDataDeclaration kind') convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =   basicDeclaration title (TypeSynonymDeclaration args ty)-convertDeclaration (P.TypeClassDeclaration _ args implies ds) title =+convertDeclaration (P.TypeClassDeclaration _ args implies _ ds) title = -- TODO: include fundep info   Just (Right (mkDeclaration title info) { declChildren = children })   where   info = TypeClassDeclaration args implies

@@ -18,36 +18,47 @@ 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 {-  -- |-  -- Value names currently in scope-  ---    names :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)-  -- |-  -- Type names currently in scope-  --+-- | The @Environment@ defines all values and types which are currently in scope:+data Environment = Environment+  { names :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)+  -- ^ Values currently in scope   , types :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)-  -- |-  -- Data constructors currently in scope, along with their associated type-  -- constructor name, argument types and return type.+  -- ^ Type names currently in scope   , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, Type, [Ident])-  -- |-  -- Type synonyms currently in scope-  --+  -- ^ Data constructors currently in scope, along with their associated type+  -- constructor name, argument types and return type.   , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(String, Maybe Kind)], Type)-  -- |-  -- Available type class dictionaries-  --+  -- ^ Type synonyms currently in scope   , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))-  -- |-  -- Type classes-  ---  , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])-  } deriving (Show)+  -- ^ Available type class dictionaries+  , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData+  -- ^ Type classes+  } deriving Show +-- | Information about a type class+data TypeClassData = TypeClassData+  { typeClassArguments :: [(String, Maybe Kind)]+  -- ^ A list of type argument names, and their kinds, where kind annotations+  -- were provided.+  , typeClassMembers :: [(Ident, Type)]+  -- ^ A list of type class members and their types. Type arguments listed above+  -- are considered bound in these types.+  , typeClassSuperclasses :: [Constraint]+  -- ^ 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.+  } deriving Show++-- | 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+ -- | -- The initial environment with no values and only the default javascript types defined --@@ -241,17 +252,19 @@     , (primName "Boolean",  (Star, ExternData))     , (primName "Partial",  (Star, ExternData))     , (primName "Fail",     (FunKind Symbol Star, ExternData))+    , (primName "TypeString", (FunKind Star Symbol, ExternData))+    , (primName "TypeConcat", (FunKind Symbol (FunKind Symbol Symbol), ExternData))     ]  -- | -- The primitive class map. This just contains to `Partial` class, used as a -- kind of magic constraint for partial functions. ---primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])+primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primClasses =   M.fromList-    [ (primName "Partial", ([], [], []))-    , (primName "Fail",    ([("message", Just Symbol)], [], []))+    [ (primName "Partial", (TypeClassData [] [] [] []))+    , (primName "Fail",    (TypeClassData [("message", Just Symbol)] [] [] []))     ]  -- |@@ -276,3 +289,4 @@ lookupValue env ident = ident `M.lookup` names env  $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)+$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''FunctionalDependency)

@@ -25,6 +25,7 @@  import Language.PureScript.AST import Language.PureScript.Crash+import Language.PureScript.Environment import Language.PureScript.Names import Language.PureScript.Pretty import Language.PureScript.Traversals@@ -32,6 +33,7 @@ import Language.PureScript.Pretty.Common (endWith) import qualified Language.PureScript.Bundle as Bundle import qualified Language.PureScript.Constants as C+import Language.PureScript.Pretty.Common (before)  import qualified System.Console.ANSI as ANSI @@ -118,6 +120,7 @@   NoInstanceFound{} -> "NoInstanceFound"   PossiblyInfiniteInstance{} -> "PossiblyInfiniteInstance"   CannotDerive{} -> "CannotDerive"+  InvalidNewtypeInstance{} -> "InvalidNewtypeInstance"   CannotFindDerivingType{} -> "CannotFindDerivingType"   DuplicateLabel{} -> "DuplicateLabel"   DuplicateValueDeclaration{} -> "DuplicateValueDeclaration"@@ -130,7 +133,6 @@   ExprDoesNotHaveType{} -> "ExprDoesNotHaveType"   PropertyIsMissing{} -> "PropertyIsMissing"   AdditionalProperty{} -> "AdditionalProperty"-  CannotApplyFunction{} -> "CannotApplyFunction"   TypeSynonymInstance -> "TypeSynonymInstance"   OrphanInstance{} -> "OrphanInstance"   InvalidNewtype{} -> "InvalidNewtype"@@ -164,6 +166,8 @@   InvalidOperatorInBinder{} -> "InvalidOperatorInBinder"   DeprecatedRequirePath{} -> "DeprecatedRequirePath"   CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"+  CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"+  NonWildcardNewtypeInstance{} -> "NonWildcardNewtypeInstance"  -- | -- A stack trace for an error@@ -254,12 +258,12 @@   gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> f t1 <*> f t2   gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> f t1 <*> f t2   gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t-  gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e   gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t   gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con   gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts   gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts   gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts+  gSimple (InvalidNewtypeInstance cl ts) = InvalidNewtypeInstance cl <$> traverse f ts   gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k   gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts   gSimple (WildcardInferredType ty ctx) = WildcardInferredType <$> f ty <*> traverse (sndM f) ctx@@ -288,6 +292,8 @@   UnusedImport{} -> emptySuggestion   DuplicateImport{} -> emptySuggestion   UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual+  UnusedDctorImport mn _ qual refs -> suggest $ importSuggestion mn refs qual+  UnusedDctorExplicitImport mn _ _ qual refs -> suggest $ importSuggestion mn refs qual   ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing   ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)   HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing@@ -592,9 +598,9 @@             , line "They may be disallowed completely in a future version of the compiler."             ]     renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"-    renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =+    renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ ty ] _)) | Just box <- toTypelevelString ty =       paras [ line "A custom type error occurred while solving type class constraints:"-            , indent . paras . map line . lines $ message+            , indent box             ]     renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial                                                           _@@ -638,6 +644,14 @@                 , Box.vcat Box.left (map typeAtomAsBox ts)                 ]             ]+    renderSimpleErrorMessage (InvalidNewtypeInstance nm ts) =+      paras [ line "Cannot derive newtype instance for"+            , markCodeBox $ indent $ Box.hsep 1 Box.left+                [ line (showQualified runProperName nm)+                , Box.vcat Box.left (map typeAtomAsBox ts)+                ]+            , line "Make sure this is a newtype."+            ]     renderSimpleErrorMessage (CannotFindDerivingType nm) =       line $ "Cannot derive a type class instance, because the type declaration for " ++ markCode (runProperName nm) ++ " could not be found."     renderSimpleErrorMessage (DuplicateLabel l expr) =@@ -677,12 +691,6 @@       line $ "Type of expression lacks required label " ++ markCode prop ++ "."     renderSimpleErrorMessage (AdditionalProperty prop) =       line $ "Type of expression contains additional label " ++ markCode prop ++ "."-    renderSimpleErrorMessage (CannotApplyFunction fn arg) =-      paras [ line "A function of type"-            , markCodeBox $ indent $ typeAsBox fn-            , line "can not be applied to the argument"-            , markCodeBox $ indent $ prettyPrintValue valueDepth arg-            ]     renderSimpleErrorMessage TypeSynonymInstance =       line "Type class instances for type synonyms are disallowed."     renderSimpleErrorMessage (OrphanInstance nm cnm ts) =@@ -756,12 +764,18 @@             , line "It could be replaced with:"             , indent $ line $ markCode $ showSuggestion msg ] -    renderSimpleErrorMessage (UnusedDctorImport name) =-      line $ "The import of type " ++ markCode (runProperName name) ++ " includes data constructors but only the type is used"+    renderSimpleErrorMessage msg@(UnusedDctorImport mn name _ _) =+      paras [line $ "The import of type " ++ markCode (runProperName name)+                    ++ " from module " ++ markCode (runModuleName mn) ++ " includes data constructors but only the type is used"+            , line "It could be replaced with:"+            , indent $ line $ markCode $ showSuggestion msg ] -    renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =-      paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"-            , indent $ paras $ map (line . markCode . runProperName) names ]+    renderSimpleErrorMessage msg@(UnusedDctorExplicitImport mn name names _ _) =+      paras [ line $ "The import of type " ++ markCode (runProperName name)+                     ++ " from module " ++ markCode (runModuleName mn) ++ " includes the following unused data constructors:"+            , indent $ paras $ map (line . markCode . runProperName) names+            , line "It could be replaced with:"+            , indent $ line $ markCode $ showSuggestion msg ]      renderSimpleErrorMessage (DuplicateSelectiveImport name) =       line $ "There is an existing import of " ++ markCode (runModuleName name) ++ ", consider merging the import lists"@@ -819,6 +833,14 @@             , line "Try adding a type signature."             ] +    renderSimpleErrorMessage (CannotDeriveNewtypeForData tyName) =+      paras [ line $ "Cannot derive an instance of the " ++ markCode "Newtype" ++ " class for non-newtype " ++ markCode (runProperName tyName) ++ "."+            ]++    renderSimpleErrorMessage (NonWildcardNewtypeInstance tyName) =+      paras [ line $ "A type wildcard (_) should be used for the inner type when deriving the " ++ markCode "Newtype" ++ " instance for " ++ markCode (runProperName tyName) ++ "."+            ]+     renderHint :: ErrorMessageHint -> Box.Box -> Box.Box     renderHint (ErrorUnifyingTypes t1 t2) detail =       paras [ detail@@ -933,7 +955,7 @@             ]     renderHint (ErrorSolvingConstraint (Constraint nm ts _)) detail =       paras [ detail-            , line "while solving type class constriant"+            , line "while solving type class constraint"             , markCodeBox $ indent $ Box.hsep 1 Box.left                 [ line (showQualified runProperName nm)                 , Box.vcat Box.left (map typeAtomAsBox ts)@@ -1016,10 +1038,6 @@      -- | See https://github.com/purescript/purescript/issues/1802     stripRedudantHints :: SimpleErrorMessage -> [ErrorMessageHint] -> [ErrorMessageHint]-    stripRedudantHints CannotApplyFunction{} = stripFirst isApplicationHint-      where-      isApplicationHint ErrorInApplication{} = True-      isApplicationHint _ = False     stripRedudantHints ExprDoesNotHaveType{} = stripFirst isCheckHint       where       isCheckHint ErrorCheckingType{} = True@@ -1043,16 +1061,16 @@     stripFirst _ [] = []    hintCategory :: ErrorMessageHint -> HintCategory-  hintCategory ErrorCheckingType{}      = ExprHint-  hintCategory ErrorInferringType{}     = ExprHint-  hintCategory ErrorInExpression{}      = ExprHint-  hintCategory ErrorUnifyingTypes{}     = CheckHint-  hintCategory ErrorInSubsumption{}     = CheckHint-  hintCategory ErrorInApplication{}     = CheckHint-  hintCategory ErrorCheckingKind{}      = CheckHint-  hintCategory ErrorSolvingConstraint{} = SolverHint-  hintCategory PositionedError{}        = PositionHint-  hintCategory _                        = OtherHint+  hintCategory ErrorCheckingType{}                  = ExprHint+  hintCategory ErrorInferringType{}                 = ExprHint+  hintCategory ErrorInExpression{}                  = ExprHint+  hintCategory ErrorUnifyingTypes{}                 = CheckHint+  hintCategory ErrorInSubsumption{}                 = CheckHint+  hintCategory ErrorInApplication{}                 = CheckHint+  hintCategory ErrorCheckingKind{}                  = CheckHint+  hintCategory ErrorSolvingConstraint{}             = SolverHint+  hintCategory PositionedError{}                    = PositionHint+  hintCategory _                                    = OtherHint  -- Pretty print and export declaration prettyPrintExport :: DeclarationRef -> String@@ -1194,6 +1212,14 @@   where   dropWhileEnd p = reverse . dropWhile p . reverse   whiteSpace = all isSpace++toTypelevelString :: Type -> Maybe Box.Box+toTypelevelString (TypeLevelString s) = Just $ Box.text s+toTypelevelString (TypeApp (TypeConstructor f) x)+  | f == primName "TypeString" = Just $ typeAsBox x+toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)+  | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)+toTypelevelString _ = Nothing  -- | -- Rethrow an error with a more detailed error message in the case of failure

@@ -93,44 +93,45 @@ data ExternsDeclaration =   -- | A type declaration     EDType-      { edTypeName :: ProperName 'TypeName-      , edTypeKind :: Kind-      , edTypeDeclarationKind :: TypeKind+      { edTypeName                :: ProperName 'TypeName+      , edTypeKind                :: Kind+      , edTypeDeclarationKind     :: TypeKind       }   -- | A type synonym   | EDTypeSynonym-      { edTypeSynonymName :: ProperName 'TypeName-      , edTypeSynonymArguments :: [(String, Maybe Kind)]-      , edTypeSynonymType :: Type+      { edTypeSynonymName         :: ProperName 'TypeName+      , edTypeSynonymArguments    :: [(String, Maybe Kind)]+      , edTypeSynonymType         :: Type       }   -- | A data construtor   | EDDataConstructor-      { edDataCtorName :: ProperName 'ConstructorName-      , edDataCtorOrigin :: DataDeclType-      , edDataCtorTypeCtor :: ProperName 'TypeName-      , edDataCtorType :: Type-      , edDataCtorFields :: [Ident]+      { edDataCtorName            :: ProperName 'ConstructorName+      , edDataCtorOrigin          :: DataDeclType+      , edDataCtorTypeCtor        :: ProperName 'TypeName+      , edDataCtorType            :: Type+      , edDataCtorFields          :: [Ident]       }   -- | A value declaration   | EDValue-      { edValueName :: Ident-      , edValueType :: Type+      { edValueName               :: Ident+      , edValueType               :: Type       }   -- | A type class declaration   | EDClass-      { edClassName :: ProperName 'ClassName-      , edClassTypeArguments :: [(String, Maybe Kind)]-      , edClassMembers :: [(Ident, Type)]-      , edClassConstraints :: [Constraint]+      { edClassName               :: ProperName 'ClassName+      , edClassTypeArguments      :: [(String, Maybe Kind)]+      , edClassMembers            :: [(Ident, Type)]+      , edClassConstraints        :: [Constraint]+      , edFunctionalDependencies  :: [FunctionalDependency]       }   -- | An instance declaration   | EDInstance-      { edInstanceClassName :: Qualified (ProperName 'ClassName)-      , edInstanceName :: Ident-      , edInstanceTypes :: [Type]-      , edInstanceConstraints :: Maybe [Constraint]+      { edInstanceClassName       :: Qualified (ProperName 'ClassName)+      , edInstanceName            :: Ident+      , edInstanceTypes           :: [Type]+      , edInstanceConstraints     :: Maybe [Constraint]       }-  deriving (Show)+  deriving Show  -- | Convert an externs file back into a module applyExternsFileToEnvironment :: ExternsFile -> Environment -> Environment@@ -141,7 +142,7 @@   applyDecl env (EDTypeSynonym pn args ty) = env { typeSynonyms = M.insert (qual pn) (args, ty) (typeSynonyms env) }   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) = env { typeClasses = M.insert (qual pn) (args, members, cs) (typeClasses env) }+  applyDecl env (EDClass pn args members cs deps) = env { typeClasses = M.insert (qual pn) (TypeClassData args members cs deps) (typeClasses env) }   applyDecl env (EDInstance className ident tys cs) = env { typeClassDictionaries = updateMap (updateMap (M.insert (qual ident) dict) className) (Just efModuleName) (typeClassDictionaries env) }     where     dict :: TypeClassDictionaryInScope@@ -204,12 +205,12 @@     | Just (ty, _, _) <- Qualified (Just mn) ident `M.lookup` names env     = [ EDValue ident ty ]   toExternsDeclaration (TypeClassRef className)-    | Just (args, members, implies) <- Qualified (Just mn) className `M.lookup` typeClasses env+    | 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) args synTy-      , EDClass className args members implies+      , EDTypeSynonym (coerceProperName className) typeClassArguments synTy+      , EDClass className typeClassArguments typeClassMembers typeClassSuperclasses typeClassDependencies       ]   toExternsDeclaration (TypeInstanceRef ident)     = [ EDInstance tcdClassName ident tcdInstanceTypes tcdDependencies

@@ -38,9 +38,9 @@ import           Language.PureScript.Ide.State import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           System.Directory-import           System.FilePath-import           System.FilePath.Glob+import           System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist)+import           System.FilePath ((</>))+import           System.FilePath.Glob (glob)  -- | Accepts a Commmand and runs it against psc-ide's State. This is the main -- entry point for the server.@@ -77,7 +77,7 @@     case rs of       Right rs' -> answerRequest outfp rs'       Left question ->-        pure (CompletionResult (map completionFromMatch question))+        pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))   Rebuild file ->     rebuildFile file   Cwd ->@@ -88,7 +88,7 @@     liftIO exitSuccess  findCompletions :: Ide m =>-                   [Filter] -> Matcher IdeDeclaration -> Maybe P.ModuleName -> m Success+                   [Filter] -> Matcher IdeDeclarationAnn -> Maybe P.ModuleName -> m Success findCompletions filters matcher currentModule = do   modules <- getAllModules currentModule   pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules@@ -97,7 +97,7 @@             Text -> [Filter] -> Maybe P.ModuleName -> m Success findType search filters currentModule = do   modules <- getAllModules currentModule-  pure . InfoResult . map infoFromMatch . getExactMatches search filters $ modules+  pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules  findPursuitCompletions :: MonadIO m =>                           PursuitQuery -> m Success

@@ -34,7 +34,7 @@       }     | Complete       { completeFilters       :: [Filter]-      , completeMatcher       :: Matcher IdeDeclaration+      , completeMatcher       :: Matcher IdeDeclarationAnn       , completeCurrentModule :: Maybe P.ModuleName       }     | Pursuit

@@ -9,24 +9,23 @@ import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types-import           Language.PureScript.Ide.Util  -- | Applies the CompletionFilters and the Matcher to the given Modules --   and sorts the found Completions according to the Matching Score getCompletions   :: [Filter]-  -> Matcher IdeDeclaration+  -> Matcher IdeDeclarationAnn   -> [Module]-  -> [Match IdeDeclaration]+  -> [Match IdeDeclarationAnn] getCompletions filters matcher modules =-  runMatcher matcher (completionsFromModules discardAnn (applyFilters filters modules))+  runMatcher matcher (completionsFromModules (applyFilters filters modules))  getExactMatches :: Text -> [Filter] -> [Module] -> [Match IdeDeclarationAnn] getExactMatches search filters modules =-  completionsFromModules identity (applyFilters (equalityFilter search : filters) modules)+  completionsFromModules (applyFilters (equalityFilter search : filters) modules) -completionsFromModules :: (IdeDeclarationAnn -> a) -> [Module] -> [Match a]-completionsFromModules f = foldMap completionFromModule+completionsFromModules :: [Module] -> [Match IdeDeclarationAnn]+completionsFromModules = foldMap completionFromModule   where     completionFromModule (moduleName, decls) =-      map (\x -> Match (moduleName, f x)) decls+      map (\x -> Match (moduleName, x)) decls

@@ -17,9 +17,9 @@ {-# LANGUAGE FlexibleContexts  #-}  module Language.PureScript.Ide.Externs-  ( readExternFile,-    convertExterns,-    annotateLocations+  ( readExternFile+  , convertExterns+  , annotateModule   ) where  import           Protolude@@ -87,26 +87,31 @@ convertOperator P.ExternsFixity{..} =   IdeValueOperator     efOperator-    (toS (P.showQualified (either P.runIdent P.runProperName) efAlias))+    efAlias     efPrecedence     efAssociativity+    Nothing  convertTypeOperator :: P.ExternsTypeFixity -> IdeDeclaration convertTypeOperator P.ExternsTypeFixity{..} =   IdeTypeOperator     efTypeOperator-    (toS (P.showQualified P.runProperName efTypeAlias))+    efTypeAlias     efTypePrecedence     efTypeAssociativity+    Nothing -annotateLocations :: Map (Either Text Text) P.SourceSpan -> Module -> Module-annotateLocations ast (moduleName, decls) =+annotateModule+  :: (DefinitionSites P.SourceSpan, TypeAnnotations)+  -> Module+  -> Module+annotateModule (defs, types) (moduleName, decls) =   (moduleName, map convertDeclaration decls)   where     convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn     convertDeclaration (IdeDeclarationAnn ann d) = case d of       IdeValue i t ->-        annotateValue (runIdentT i) (IdeValue i t)+        annotateFunction i (IdeValue i t)       IdeType i k ->         annotateType (runProperNameT i) (IdeType i k)       IdeTypeSynonym i t ->@@ -115,10 +120,13 @@         annotateValue (runProperNameT i) (IdeDataConstructor i tn t)       IdeTypeClass i ->         annotateType (runProperNameT i) (IdeTypeClass i)-      IdeValueOperator n i p a ->-        annotateValue i (IdeValueOperator n i p a)-      IdeTypeOperator n i p a ->-        annotateType i (IdeTypeOperator n i p a)+      IdeValueOperator n i p a t ->+        annotateValue (valueOperatorAliasT i) (IdeValueOperator n i p a t)+      IdeTypeOperator n i p a k ->+        annotateType (typeOperatorAliasT i) (IdeTypeOperator n i p a k)       where-        annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) ast})-        annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) ast})+        annotateFunction x = IdeDeclarationAnn (ann { annLocation = Map.lookup (Left (runIdentT x)) defs+                                                    , annTypeAnnotation = Map.lookup x types+                                                    })+        annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) defs})+        annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) defs})

@@ -203,9 +203,9 @@       P.TypeRef tn (Just [n])     refFromDeclaration (IdeType n _) =       P.TypeRef n (Just [])-    refFromDeclaration (IdeValueOperator op _ _ _) =+    refFromDeclaration (IdeValueOperator op _ _ _ _) =       P.ValueOpRef op-    refFromDeclaration (IdeTypeOperator op _ _ _) =+    refFromDeclaration (IdeTypeOperator op _ _ _ _) =       P.TypeOpRef op     refFromDeclaration d =       P.ValueRef $ P.Ident $ T.unpack (identifierFromIdeDeclaration d)

@@ -38,7 +38,7 @@  newtype Matcher a = Matcher (Endo [Match a]) deriving (Monoid) -instance FromJSON (Matcher IdeDeclaration) where+instance FromJSON (Matcher IdeDeclarationAnn) where   parseJSON = withObject "matcher" $ \o -> do     (matcher :: Maybe Text) <- o .:? "matcher"     case matcher of@@ -60,17 +60,17 @@ -- Examples: --   flMa matches flexMatcher. Score: 14.28 --   sons matches sortCompletions. Score: 6.25-flexMatcher :: Text -> Matcher IdeDeclaration+flexMatcher :: Text -> Matcher IdeDeclarationAnn flexMatcher p = mkMatcher (flexMatch p) -distanceMatcher :: Text -> Int -> Matcher IdeDeclaration+distanceMatcher :: Text -> Int -> Matcher IdeDeclarationAnn distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist) -distanceMatcher' :: Text -> Int -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration]+distanceMatcher' :: Text -> Int -> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn] distanceMatcher' q maxDist = mapMaybe go   where     go m = let d = dist (T.unpack y)-               y = identifierFromIdeDeclaration (unwrapMatch m)+               y = identifierFromIdeDeclaration (discardAnn (unwrapMatch m))           in if d <= maxDist              then Just (m, 1 / fromIntegral d)              else Nothing@@ -85,12 +85,12 @@ sortCompletions :: [ScoredMatch a] -> [ScoredMatch a] sortCompletions = sortBy (flip compare `on` snd) -flexMatch :: Text -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration]+flexMatch :: Text -> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn] flexMatch = mapMaybe . flexRate -flexRate :: Text -> Match IdeDeclaration -> Maybe (ScoredMatch IdeDeclaration)+flexRate :: Text -> Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn) flexRate p c = do-  score <- flexScore p (identifierFromIdeDeclaration (unwrapMatch c))+  score <- flexScore p (identifierFromIdeDeclaration (discardAnn (unwrapMatch c)))   return (c, score)  -- FlexMatching ala Sublime.

@@ -35,41 +35,37 @@ -- TODO: remove this when the issue is fixed at Pursuit queryPursuit :: Text -> IO ByteString queryPursuit q = do-  let qClean = T.dropWhileEnd (== '.') q-  req' <- parseRequest "http://pursuit.purescript.org/search"-  let req = req'-        { queryString= "q=" <> (fromString . T.unpack) qClean-        , requestHeaders=[(hAccept, "application/json")]-        }-  m <- newManager tlsManagerSettings-  withHTTP req m $ \resp ->-    P.fold (<>) "" identity (responseBody resp)-+    let qClean = T.dropWhileEnd (== '.') q+    req' <- parseRequest "http://pursuit.purescript.org/search"+    let req = req'+          { queryString= "q=" <> (fromString . T.unpack) qClean+          , requestHeaders=[(hAccept, "application/json")]+          }+    m <- newManager tlsManagerSettings+    withHTTP req m $ \resp ->+      P.fold (<>) "" identity (responseBody resp)  handler :: HttpException -> IO [a]-handler StatusCodeException{} = pure [] handler _ = pure []  searchPursuitForDeclarations :: Text -> IO [PursuitResponse]-searchPursuitForDeclarations query =-    (do r <- queryPursuit query-        let results' = decode (fromStrict r) :: Maybe Array-        case results' of-          Nothing -> pure []-          Just results -> pure (mapMaybe (isDeclarationResponse . fromJSON) (toList results))) `E.catch`-    handler+searchPursuitForDeclarations query = E.handle handler $ do+    r <- queryPursuit query+    let results' = decode (fromStrict r) :: Maybe Array+    case results' of+        Nothing -> pure []+        Just results -> pure (mapMaybe (isDeclarationResponse . fromJSON) (toList results))   where     isDeclarationResponse (Success a@DeclarationResponse{}) = Just a     isDeclarationResponse _ = Nothing  findPackagesForModuleIdent :: Text -> IO [PursuitResponse]-findPackagesForModuleIdent query =-  (do r <- queryPursuit query-      let results' = decode (fromStrict r) :: Maybe Array-      case results' of+findPackagesForModuleIdent query = E.handle handler $ do+    r <- queryPursuit query+    let results' = decode (fromStrict r) :: Maybe Array+    case results' of         Nothing -> pure []-        Just results -> pure (mapMaybe (isModuleResponse . fromJSON) (toList results))) `E.catch`-  handler+        Just results -> pure (mapMaybe (isModuleResponse . fromJSON) (toList results))   where     isModuleResponse (Success a@ModuleResponse{}) = Just a     isModuleResponse _ = Nothing

@@ -144,7 +144,8 @@            . M.elems            . M.delete (P.getModuleName m) $ ex   case sorted' of-    Left _ -> throwError (GeneralError "There was a cycle in the dependencies")+    Left err ->+      throwError (RebuildError (toJSONErrors False P.Error err))     Right (sorted, graph) -> do       let deps = fromJust (List.lookup (P.getModuleName m) graph)       pure $ mapMaybe getExtern (deps `inOrderOf` map P.getModuleName sorted)

@@ -14,8 +14,6 @@ -----------------------------------------------------------------------------  {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports    #-}-{-# LANGUAGE TemplateHaskell   #-} {-# LANGUAGE RecordWildCards   #-}  module Language.PureScript.Ide.Reexports@@ -93,9 +91,9 @@   P.ValueRef i ->     findWrapped (\case IdeValue i' _ -> i' == i; _ -> False)   P.TypeOpRef name ->-    findWrapped (\case IdeTypeOperator n _ _ _ -> n == name; _ -> False)+    findWrapped (\case IdeTypeOperator n _ _ _ _ -> n == name; _ -> False)   P.ValueOpRef name ->-    findWrapped (\case IdeValueOperator n _ _ _ -> n == name; _ -> False)+    findWrapped (\case IdeValueOperator n _ _ _ _ -> n == name; _ -> False)   P.TypeClassRef name ->     findWrapped (\case IdeTypeClass n -> n == name; _ -> False)   _ ->

@@ -17,11 +17,15 @@ module Language.PureScript.Ide.SourceFile   ( parseModule   , getImportsForFile+  , extractAstInformation+  -- for tests   , extractSpans+  , extractTypeAnnotations   ) where  import           Protolude +import qualified Data.Map as Map import qualified Language.PureScript                  as P import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Util@@ -64,6 +68,25 @@         unwrapImportType (P.Hiding decls)   = P.Hiding (map unwrapPositionedRef decls)         unwrapImportType P.Implicit         = P.Implicit +-- | Extracts AST information from a parsed module+extractAstInformation+  :: P.Module+  -> (DefinitionSites P.SourceSpan, TypeAnnotations)+extractAstInformation (P.Module ss _ _ decls _) =+  let definitions = Map.fromList (concatMap (extractSpans ss) decls)+      typeAnnotations = Map.fromList (extractTypeAnnotations decls)+  in (definitions, typeAnnotations)++-- | Extracts type annotations for functions from a given Module+extractTypeAnnotations+  :: [P.Declaration]+  -> [(P.Ident, P.Type)]+extractTypeAnnotations = mapMaybe extract+  where+    extract d = case unwrapPositioned d of+      P.TypeDeclaration ident ty -> Just (ident, ty)+      _ -> Nothing+ -- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts -- definition sites inside that Declaration. extractSpans@@ -81,7 +104,7 @@     [(Left (runIdentT i), ss)]   P.TypeSynonymDeclaration name _ _ ->     [(Right (runProperNameT name), ss)]-  P.TypeClassDeclaration name _ _ members ->+  P.TypeClassDeclaration name _ _ _ members ->     (Right (runProperNameT name), ss) : concatMap (extractSpans' ss) members   P.DataDeclaration _ name _ ctors ->     (Right (runProperNameT name), ss)

@@ -28,6 +28,8 @@   , populateStage2   , populateStage3   , populateStage3STM+  -- for tests+  , resolveOperatorsForModule   ) where  import           Protolude@@ -35,7 +37,8 @@  import           Control.Concurrent.STM import           "monad-logger" Control.Monad.Logger-import qualified Data.Map.Lazy                     as M+import qualified Data.Map.Lazy                     as Map+import qualified Data.List                         as List import           Language.PureScript.Externs import           Language.PureScript.Ide.Externs import           Language.PureScript.Ide.Reexports@@ -55,10 +58,10 @@  -- | Gets the loaded Modulenames getLoadedModulenames :: Ide m => m [P.ModuleName]-getLoadedModulenames = M.keys <$> getExternFiles+getLoadedModulenames = Map.keys <$> getExternFiles  -- | Gets all loaded ExternFiles-getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)+getExternFiles :: Ide m => m (Map P.ModuleName ExternsFile) getExternFiles = s1Externs <$> getStage1  -- | Insert a Module into Stage1 of the State@@ -72,7 +75,7 @@ insertModuleSTM ref (fp, module') =   modifyTVar ref $ \x ->     x { ideStage1 = (ideStage1 x) {-          s1Modules = M.insert+          s1Modules = Map.insert             (P.getModuleName module')             (module', fp)             (s1Modules (ideStage1 x))}}@@ -126,18 +129,25 @@   declarations <- s3Declarations <$> getStage3   rebuild <- cachedRebuild   case mmoduleName of-    Nothing -> pure (M.toList declarations)+    Nothing -> pure (Map.toList declarations)     Just moduleName ->       case rebuild of         Just (cachedModulename, ef)           | cachedModulename == moduleName -> do               (AstData asts) <- s2AstData <$> getStage2-              let ast = fromMaybe M.empty (M.lookup moduleName asts)-              pure . M.toList $-                M.insert moduleName-                (snd . annotateLocations ast . fst . convertExterns $ ef) declarations-        _ -> pure (M.toList declarations)+              let+                ast =+                  fromMaybe (Map.empty, Map.empty) (Map.lookup moduleName asts)+                cachedModule =+                  snd . annotateModule ast . fst . convertExterns $ ef+                tmp =+                  Map.insert moduleName cachedModule declarations+                resolved =+                  Map.adjust (resolveOperatorsForModule tmp) moduleName tmp +              pure (Map.toList resolved)+        _ -> pure (Map.toList declarations)+ -- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the -- following Stages, which needs to be done after all the necessary Exterms have -- been loaded.@@ -151,7 +161,7 @@ insertExternsSTM ref ef =   modifyTVar ref $ \x ->     x { ideStage1 = (ideStage1 x) {-          s1Externs = M.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}+          s1Externs = Map.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}  -- | Sets rebuild cache to the given ExternsFile cacheRebuild :: Ide m => ExternsFile -> m ()@@ -180,8 +190,8 @@ populateStage2STM :: TVar IdeState -> STM () populateStage2STM ref = do   modules <- s1Modules <$> getStage1STM ref-  let spans = map (\((P.Module ss _ _ decls _), _) -> M.fromList (concatMap (extractSpans ss) decls)) modules-  setStage2STM ref (Stage2 (AstData spans))+  let astData = map (extractAstInformation . fst) modules+  setStage2STM ref (Stage2 (AstData astData))  -- | Resolves reexports and populates Stage3 with data to be used in queries. populateStage3 :: (Ide m, MonadLogger m) => m ()@@ -202,12 +212,70 @@ populateStage3STM ref = do   externs <- s1Externs <$> getStage1STM ref   (AstData asts) <- s2AstData <$> getStage2STM ref-  let modules = M.map convertExterns externs+  let modules = Map.map convertExterns externs       nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])-      nModules = M.mapWithKey+      nModules = Map.mapWithKey         (\moduleName (m, refs) ->-           (fromMaybe m $ annotateLocations <$> M.lookup moduleName asts <*> pure m, refs)) modules+           (fromMaybe m $ annotateModule <$> Map.lookup moduleName asts <*> pure m, refs)) modules       -- resolves reexports and discards load failures for now-      result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules-  setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)+      result = resolveReexports (map (snd . fst) nModules) <$> Map.elems nModules+      resultP = resolveOperators (Map.fromList (reResolved <$> result))+  setStage3STM ref (Stage3 resultP Nothing)   pure result++resolveOperators+  :: Map P.ModuleName [IdeDeclarationAnn]+  -> Map P.ModuleName [IdeDeclarationAnn]+resolveOperators modules =+  map (resolveOperatorsForModule modules) modules++-- | Looks up the types and kinds for operators and assigns them to their+-- declarations+resolveOperatorsForModule+  :: Map P.ModuleName [IdeDeclarationAnn]+  -> [IdeDeclarationAnn]+  -> [IdeDeclarationAnn]+resolveOperatorsForModule modules = map (mapIdeDeclaration resolveOperator)+  where+    resolveOperator (IdeValueOperator+                    opName+                    i@(P.Qualified (Just moduleName)+                        (Left ident)) precedence assoc _) =+      let t = do+            sourceModule <- Map.lookup moduleName modules+            IdeValue _ tP <-+              List.find (\case+                            IdeValue iP _ -> iP == ident+                            _ -> False) (discardAnn <$> sourceModule)+            pure tP++      in IdeValueOperator opName i precedence assoc t+    resolveOperator (IdeValueOperator+                    opName+                    i@(P.Qualified (Just moduleName)+                        (Right ctor)) precedence assoc _) =+      let t = do+            sourceModule <- Map.lookup moduleName modules+            IdeDataConstructor _ _ tP <-+              List.find (\case+                            IdeDataConstructor cname _ _ -> ctor == cname+                            _ -> False) (discardAnn <$> sourceModule)+            pure tP++      in IdeValueOperator opName i precedence assoc t+    resolveOperator (IdeTypeOperator+                    opName+                    i@(P.Qualified (Just moduleName) properName) precedence assoc _)  =+      let k = do+            sourceModule <- Map.lookup moduleName modules+            IdeType _ kP <-+              List.find (\case+                            IdeType name _ -> name == properName+                            _ -> False) (discardAnn <$> sourceModule)+            pure kP++      in IdeTypeOperator opName i precedence assoc k+    resolveOperator x = x++mapIdeDeclaration :: (IdeDeclaration -> IdeDeclaration) -> IdeDeclarationAnn -> IdeDeclarationAnn+mapIdeDeclaration f (IdeDeclarationAnn ann decl) = IdeDeclarationAnn ann (f decl)

@@ -21,12 +21,10 @@  import           Control.Concurrent.STM import           Data.Aeson-import           Data.Map.Lazy                        as M+import qualified Data.Map.Lazy                        as M import qualified Language.PureScript.Errors.JSON      as P import qualified Language.PureScript as P import           Language.PureScript.Ide.Conversions-import           Text.Parsec as Parsec-import           Text.Parsec.Text  type ModuleIdent = Text @@ -36,8 +34,8 @@   | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type   | IdeDataConstructor (P.ProperName 'P.ConstructorName) (P.ProperName 'P.TypeName) P.Type   | IdeTypeClass (P.ProperName 'P.ClassName)-  | IdeValueOperator (P.OpName 'P.ValueOpName) Text P.Precedence P.Associativity-  | IdeTypeOperator (P.OpName 'P.TypeOpName) Text P.Precedence P.Associativity+  | IdeValueOperator (P.OpName 'P.ValueOpName) (P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName))) P.Precedence P.Associativity (Maybe P.Type)+  | IdeTypeOperator (P.OpName 'P.TypeOpName) (P.Qualified (P.ProperName 'P.TypeName)) P.Precedence P.Associativity (Maybe P.Kind)   deriving (Show, Eq, Ord)  data IdeDeclarationAnn = IdeDeclarationAnn Annotation IdeDeclaration@@ -47,15 +45,19 @@   = Annotation   { annLocation     :: Maybe P.SourceSpan   , annExportedFrom :: Maybe P.ModuleName+  , annTypeAnnotation :: Maybe P.Type   } deriving (Show, Eq, Ord)  emptyAnn :: Annotation-emptyAnn = Annotation Nothing Nothing+emptyAnn = Annotation Nothing Nothing Nothing  type Module = (P.ModuleName, [IdeDeclarationAnn]) -newtype AstData a =-  AstData (Map P.ModuleName (Map (Either Text Text) a))+type DefinitionSites a = Map (Either Text Text) a+type TypeAnnotations = Map P.Ident P.Type+newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))+  -- ^ SourceSpans for the definition sites of Values and Types aswell as type+  -- annotations found in a module   deriving (Show, Eq, Ord, Functor, Foldable)  data Configuration =@@ -108,21 +110,25 @@ newtype Match a = Match (P.ModuleName, a)            deriving (Show, Eq, Functor) -newtype Completion =-  Completion (Text, Text, Text)-  deriving (Show,Eq)--newtype Info =-  Info (Text, Text, Text, Maybe P.SourceSpan)-  deriving (Show,Eq)--instance ToJSON Info where-  toJSON (Info (m, d, t, sourceSpan)) =-    object ["module" .= m, "identifier" .= d, "type" .= t, "definedAt" .= sourceSpan]+-- | A completion as it gets sent to the editors+data Completion = Completion+  { complModule :: Text+  , complIdentifier :: Text+  , complType :: Text+  , complExpandedType :: Text+  , complLocation :: Maybe P.SourceSpan+  , complDocumentation :: Maybe Text+  } deriving (Show, Eq)  instance ToJSON Completion where-  toJSON (Completion (m, d, t)) =-    object ["module" .= m, "identifier" .= d, "type" .= t]+  toJSON (Completion {..}) =+    object [ "module" .= complModule+           , "identifier" .= complIdentifier+           , "type" .= complType+           , "expandedType" .= complExpandedType+           , "definedAt" .= complLocation+           , "documentation" .= complDocumentation+           ]  data ModuleImport =   ModuleImport@@ -140,17 +146,17 @@   toJSON (ModuleImport mn P.Implicit qualifier) =     object $ [ "module" .= mn              , "importType" .= ("implicit" :: Text)-             ] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)-  toJSON (ModuleImport mn (P.Explicit refs) _) =-    object [ "module" .= mn-           , "importType" .= ("explicit" :: Text)-           , "identifiers" .= (identifierFromDeclarationRef <$> refs)-           ]-  toJSON (ModuleImport mn (P.Hiding refs) _) =-    object [ "module" .= mn-           , "importType" .= ("hiding" :: Text)-           , "identifiers" .= (identifierFromDeclarationRef <$> refs)-           ]+             ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)+  toJSON (ModuleImport mn (P.Explicit refs) qualifier) =+    object $ [ "module" .= mn+             , "importType" .= ("explicit" :: Text)+             , "identifiers" .= (identifierFromDeclarationRef <$> refs)+             ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)+  toJSON (ModuleImport mn (P.Hiding refs) qualifier) =+    object $ [ "module" .= mn+             , "importType" .= ("hiding" :: Text)+             , "identifiers" .= (identifierFromDeclarationRef <$> refs)+             ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)  identifierFromDeclarationRef :: P.DeclarationRef -> Text identifierFromDeclarationRef (P.TypeRef name _) = runProperNameT name@@ -160,14 +166,13 @@  data Success =   CompletionResult [Completion]-  | InfoResult [Info]   | TextResult Text   | MultilineTextResult [Text]   | PursuitResult [PursuitResponse]   | ImportList [ModuleImport]   | ModuleList [ModuleIdent]   | RebuildSuccess [P.JSONError]-  deriving(Show, Eq)+  deriving (Show, Eq)  encodeSuccess :: (ToJSON a) => a -> Value encodeSuccess res =@@ -175,7 +180,6 @@  instance ToJSON Success where   toJSON (CompletionResult cs) = encodeSuccess cs-  toJSON (InfoResult i) = encodeSuccess i   toJSON (TextResult t) = encodeSuccess t   toJSON (MultilineTextResult ts) = encodeSuccess ts   toJSON (PursuitResult resp) = encodeSuccess resp@@ -203,9 +207,9 @@   -- | A Pursuit Response for a module. Consists of the modules name and the   -- package it belongs to   ModuleResponse ModuleIdent Text-  -- | A Pursuit Response for a declaration. Consist of the declarations type,-  -- module, name and package-  | DeclarationResponse Text ModuleIdent Text Text+  -- | A Pursuit Response for a declaration. Consist of the declaration's+  -- module, name, package, type summary text+  | DeclarationResponse Text ModuleIdent Text (Maybe Text) Text   deriving (Show,Eq)  instance FromJSON PursuitResponse where@@ -219,42 +223,21 @@         pure (ModuleResponse name package)       "declaration" -> do         moduleName <- info .: "module"-        Right (ident, declType) <- typeParse <$> o .: "text"-        pure (DeclarationResponse declType moduleName ident package)+        ident <- info .: "title"+        (text :: Text) <- o .: "text"+        typ <- info .:? "typeText"+        pure (DeclarationResponse moduleName ident package typ text)       _ -> mzero   parseJSON _ = mzero --typeParse :: Text -> Either Text (Text, Text)-typeParse t = case parse parseType "" t of-  Right (x,y) -> Right (x, y)-  Left err -> Left (show err)-  where-    parseType :: Parser (Text, Text)-    parseType = do-      name <- identifier-      _ <- string "::"-      spaces-      type' <- many1 anyChar-      pure (name, toS type')--    identifier :: Parser Text-    identifier = do-      spaces-      ident <--        -- necessary for being able to parse the following ((++), concat)-        between (char '(') (char ')') (many1 (noneOf ", )")) Parsec.<|>-        many1 (noneOf ", )")-      spaces-      pure (toS ident)- instance ToJSON PursuitResponse where   toJSON (ModuleResponse name package) =     object ["module" .= name, "package" .= package]-  toJSON (DeclarationResponse module' ident type' package) =+  toJSON (DeclarationResponse module' ident package type' text) =     object       [ "module"  .= module'       , "ident"   .= ident       , "type"    .= type'       , "package" .= package+      , "text"    .= text       ]

@@ -20,10 +20,12 @@   , unwrapPositioned   , unwrapPositionedRef   , completionFromMatch-  , infoFromMatch   , encodeT   , decodeT   , discardAnn+  , withEmptyAnn+  , valueOperatorAliasT+  , typeOperatorAliasT   , module Language.PureScript.Ide.Conversions   ) where @@ -42,31 +44,41 @@   IdeTypeSynonym name _ -> runProperNameT name   IdeDataConstructor name _ _ -> runProperNameT name   IdeTypeClass name -> runProperNameT name-  IdeValueOperator op _ _ _ -> runOpNameT op-  IdeTypeOperator op _ _ _ -> runOpNameT op+  IdeValueOperator op _ _ _ _ -> runOpNameT op+  IdeTypeOperator op _ _ _ _ -> runOpNameT op  discardAnn :: IdeDeclarationAnn -> IdeDeclaration discardAnn (IdeDeclarationAnn _ d) = d +withEmptyAnn :: IdeDeclaration -> IdeDeclarationAnn+withEmptyAnn = IdeDeclarationAnn emptyAnn+ unwrapMatch :: Match a -> a unwrapMatch (Match (_, ed)) = ed -completionFromMatch :: Match IdeDeclaration -> Completion-completionFromMatch = Completion . completionFromMatch'--completionFromMatch' :: Match IdeDeclaration -> (Text, Text, Text)-completionFromMatch' (Match (m', d)) = case d of-  IdeValue name type' -> (m, runIdentT name, prettyTypeT type')-  IdeType name kind -> (m, runProperNameT name, toS (P.prettyPrintKind kind))-  IdeTypeSynonym name kind -> (m, runProperNameT name, prettyTypeT kind)-  IdeDataConstructor name _ type' -> (m, runProperNameT name, prettyTypeT type')-  IdeTypeClass name -> (m, runProperNameT name, "class")-  IdeValueOperator op ref precedence associativity ->-    (m, runOpNameT op, showFixity precedence associativity ref op)-  IdeTypeOperator op ref precedence associativity ->-    (m, runOpNameT op, showFixity precedence associativity ref op)+completionFromMatch :: Match IdeDeclarationAnn -> Completion+completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =+  Completion {..}   where-    m = runModuleNameT m'+    (complIdentifier, complExpandedType) = case decl of+      IdeValue name type' -> (runIdentT name, prettyTypeT type')+      IdeType name kind -> (runProperNameT name, toS (P.prettyPrintKind kind))+      IdeTypeSynonym name kind -> (runProperNameT name, prettyTypeT kind)+      IdeDataConstructor name _ type' -> (runProperNameT name, prettyTypeT type')+      IdeTypeClass name -> (runProperNameT name, "class")+      IdeValueOperator op ref precedence associativity typeP ->+        (runOpNameT op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyTypeT typeP) +      IdeTypeOperator op ref precedence associativity kind ->+        (runOpNameT op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) (toS . P.prettyPrintKind) kind)+            +    complModule = runModuleNameT m++    complType = maybe complExpandedType prettyTypeT (annTypeAnnotation ann)+    +    complLocation = annLocation ann++    complDocumentation = Nothing+         showFixity p a r o =       let asso = case a of             P.Infix -> "infix"@@ -74,12 +86,16 @@             P.Infixr -> "infixr"       in T.unwords [asso, show p, r, "as", runOpNameT o] -infoFromMatch :: Match IdeDeclarationAnn -> Info-infoFromMatch (Match (m, (IdeDeclarationAnn ann d))) =-  Info (a, b, c, annLocation ann)-  where-    (a, b, c) = completionFromMatch' (Match (m, d))+valueOperatorAliasT+  :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName)) -> Text+valueOperatorAliasT i =+  toS (P.showQualified (either P.runIdent P.runProperName) i) +typeOperatorAliasT+  :: P.Qualified (P.ProperName 'P.TypeName) -> Text+typeOperatorAliasT i =+  toS (P.showQualified P.runProperName i)+   encodeT :: (ToJSON a) => a -> Text encodeT = toS . decodeUtf8 . encode @@ -87,9 +103,9 @@ decodeT = decode . encodeUtf8 . toS  unwrapPositioned :: P.Declaration -> P.Declaration-unwrapPositioned (P.PositionedDeclaration _ _ x) = x+unwrapPositioned (P.PositionedDeclaration _ _ x) = unwrapPositioned x unwrapPositioned x = x  unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef-unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x+unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x unwrapPositionedRef x = x

@@ -206,7 +206,7 @@   getDeclNames d@(P.ValueDeclaration ident _ _ _)  = [(ident, d)]   getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]   getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]-  getDeclNames d@(P.TypeClassDeclaration _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds+  getDeclNames d@(P.TypeClassDeclaration _ _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds   getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d   getDeclNames _ = [] @@ -214,7 +214,7 @@ dctorNames = nubOnFst . concatMap go . P.exportedDeclarations   where   go :: P.Declaration -> [(N.ProperName 'N.ConstructorName, P.Declaration)]-  go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)+  go decl@(P.DataDeclaration _ _ _ ctors) = map ((\n -> (n, decl)) . fst) ctors   go (P.PositionedDeclaration _ _ d) = go d   go _ = [] 

@@ -17,7 +17,7 @@ -- Pretty print a module's signatures -- printModuleSignatures :: P.ModuleName -> P.Environment -> String-printModuleSignatures moduleName (P.Environment {..}) =+printModuleSignatures moduleName P.Environment{..} =     -- get relevant components of a module from environment     let moduleNamesIdent = byModuleName names         moduleTypeClasses = byModuleName typeClasses@@ -44,34 +44,34 @@         showNameType _ = P.internalError "The impossible happened in printModuleSignatures."          findTypeClass-          :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint])+          :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) P.TypeClassData           -> P.Qualified (P.ProperName 'P.ClassName)-          -> (P.Qualified (P.ProperName 'P.ClassName), Maybe ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint]))+          -> (P.Qualified (P.ProperName 'P.ClassName), Maybe P.TypeClassData)         findTypeClass envTypeClasses name = (name, M.lookup name envTypeClasses)          showTypeClass-          :: (P.Qualified (P.ProperName 'P.ClassName), Maybe ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint]))+          :: (P.Qualified (P.ProperName 'P.ClassName), Maybe P.TypeClassData)           -> Maybe Box.Box         showTypeClass (_, Nothing) = Nothing-        showTypeClass (P.Qualified _ name, Just (vars, body, constrs)) =+        showTypeClass (P.Qualified _ name, Just P.TypeClassData{..}) =             let constraints =-                    if null constrs+                    if null typeClassSuperclasses                     then Box.text ""                     else Box.text "("-                         Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint (P.Qualified _ pn) lt _) -> Box.text (P.runProperName pn) Box.<+> Box.hcat Box.left (map P.typeAtomAsBox lt)) constrs)+                         Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint (P.Qualified _ pn) lt _) -> Box.text (P.runProperName pn) Box.<+> Box.hcat Box.left (map P.typeAtomAsBox lt)) typeClassSuperclasses)                          Box.<> Box.text ") <= "                 className =                     Box.text (P.runProperName name)-                    Box.<> Box.text (concatMap ((' ':) . fst) vars)+                    Box.<> Box.text (concatMap ((' ':) . fst) typeClassArguments)                 classBody =-                    Box.vcat Box.top (map (\(i, t) -> Box.text (P.showIdent i ++ " ::") Box.<+> P.typeAsBox t) body)+                    Box.vcat Box.top (map (\(i, t) -> Box.text (P.showIdent i ++ " ::") Box.<+> P.typeAsBox t) typeClassMembers)              in               Just $                 (Box.text "class "                 Box.<> constraints                 Box.<> className-                Box.<+> if null body then Box.text "" else Box.text "where")+                Box.<+> if null typeClassMembers then Box.text "" else Box.text "where")                 Box.// Box.moveRight 2 classBody  @@ -82,7 +82,7 @@         findType envTypes name = (name, M.lookup name envTypes)          showType-          :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint])+          :: 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.Type, [P.Ident])           -> M.Map (P.Qualified (P.ProperName 'P.TypeName)) ([(String, Maybe P.Kind)], P.Type)           -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.Kind, P.TypeKind))

@@ -42,11 +42,11 @@ type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)  psciImportedModuleNames :: PSCiState -> [P.ModuleName]-psciImportedModuleNames (PSCiState{psciImportedModules = is}) =+psciImportedModuleNames PSCiState{psciImportedModules = is} =   map (\(mn, _, _) -> mn) is  allImportsOf :: P.Module -> PSCiState -> [ImportedModule]-allImportsOf m (PSCiState{psciImportedModules = is}) =+allImportsOf m PSCiState{psciImportedModules = is} =   filter isImportOfThis is   where   name = P.getModuleName m

@@ -245,10 +245,10 @@       -- If we've not already warned a type is unused, check its data constructors       unless' (runProperName tn `notElem` usedNames) $         case (c, dctors `intersect` allCtors) of-          (_, []) | c /= Just [] -> warn (UnusedDctorImport tn)+          (_, []) | c /= Just [] -> warn (UnusedDctorImport mni tn qualifierName allRefs)           (Just ctors, dctors') ->             let ddiff = ctors \\ dctors'-            in unless' (null ddiff) $ warn $ UnusedDctorExplicitImport tn ddiff+            in unless' (null ddiff) $ warn $ UnusedDctorExplicitImport mni tn ddiff qualifierName allRefs           _ -> return False      return (didWarn || or didWarn')

@@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}  module Language.PureScript.Make   (@@ -36,6 +37,7 @@ import Control.Monad.Writer.Class (MonadWriter(..))  import Data.Aeson (encode, decode)+import qualified Data.Aeson as Aeson import Data.ByteString.Builder (toLazyByteString, stringUtf8) import Data.Either (partitionEithers) import Data.Foldable (for_)@@ -69,6 +71,7 @@ import qualified Language.PureScript.CodeGen.JS as J import qualified Language.PureScript.Constants as C import qualified Language.PureScript.CoreFn as CF+import qualified Language.PureScript.CoreFn.ToJSON as CFJ import qualified Language.PureScript.Parser as PSParser  import qualified Paths_purescript as Paths@@ -369,6 +372,12 @@       for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)       writeTextFile externsFile exts     lift $ when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings+    dumpCoreFn <- lift $ asks optionsDumpCoreFn+    when dumpCoreFn $ do+      let coreFnFile = outputDir </> filePath </> "corefn.json"+      let jsonPayload = CFJ.moduleToJSON Paths.version m+      let json = Aeson.object [ (fromString (runModuleName mn), jsonPayload) ]+      lift $ writeTextFile coreFnFile (BU8.toString . B.toStrict . encode $ json)    genSourceMap :: String -> String -> Int -> [SMap] -> Make ()   genSourceMap dir mapFile extraLines mappings = do

@@ -31,9 +31,12 @@     -- |     -- Generate soure maps   , optionsSourceMaps :: Bool+    -- |+    -- Dump CoreFn+  , optionsDumpCoreFn :: Bool   } deriving Show  -- | -- Default make options defaultOptions :: Options-defaultOptions = Options False False Nothing False False False False+defaultOptions = Options False False Nothing False False False False False

@@ -17,6 +17,7 @@  import Prelude hiding (lex) +import Data.Functor (($>)) import Data.Maybe (fromMaybe)  import Control.Applicative@@ -183,10 +184,15 @@     return implies   className <- indented *> properName   idents <- P.many (indented *> kindedIdent)+  let parseNamedIdent = foldl (<|>) empty (zipWith (\(name, _) index -> lname' name $> index) idents [0..])+      parseFunctionalDependency =+        FunctionalDependency <$> P.many parseNamedIdent <* rarrow+                             <*> P.many parseNamedIdent+  dependencies <- P.option [] (indented *> pipe *> commaSep1 parseFunctionalDependency)   members <- P.option [] $ do     indented *> reserved "where"     indented *> mark (P.many (same *> positioned parseTypeDeclaration))-  return $ TypeClassDeclaration className idents implies members+  return $ TypeClassDeclaration className idents implies dependencies members  parseConstraint :: TokenParser Constraint parseConstraint = Constraint <$> parseQualified properName@@ -203,7 +209,7 @@     rfatArrow     return deps   className <- indented *> parseQualified properName-  ty <- P.many (indented *> noWildcards parseTypeAtom)+  ty <- P.many (indented *> parseTypeAtom)   return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty  parseTypeInstanceDeclaration :: TokenParser Declaration@@ -217,8 +223,9 @@ parseDerivingInstanceDeclaration :: TokenParser Declaration parseDerivingInstanceDeclaration = do   reserved "derive"+  ty <- P.option DerivedInstance (reserved "newtype" $> NewtypeInstance)   instanceDecl <- parseInstanceDeclaration-  return $ instanceDecl DerivedInstance+  return $ instanceDecl ty  positioned :: TokenParser Declaration -> TokenParser Declaration positioned = withSourceSpan PositionedDeclaration

@@ -40,6 +40,7 @@   , commaSep   , commaSep1   , lname+  , lname'   , qualifier   , tyname   , uname@@ -412,6 +413,12 @@ lname = token go P.<?> "identifier"   where   go (LName s) = Just s+  go _ = Nothing++lname' :: String -> TokenParser ()+lname' s = token go P.<?> show s+  where+  go (LName s') | s == s' = Just ()   go _ = Nothing  qualifier :: TokenParser String

@@ -54,8 +54,7 @@ -- parseTypeAtom :: TokenParser Type parseTypeAtom = indented *> P.choice-            [ P.try parseConstrainedType-            , P.try parseFunction+            [ P.try parseFunction             , parseTypeLevelString             , parseObject             , parseTypeWildcard@@ -81,9 +80,8 @@     ty <- P.many parseTypeAtom     return (Constraint className ty Nothing) - parseAnyType :: TokenParser Type-parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"+parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable (P.try parseConstrainedType <|> parseTypeAtom)) P.<?> "type"   where   operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]               , [ P.Infix (P.try (parseQualified parseOperator) >>= \ident ->

@@ -74,7 +74,7 @@   -- |   -- Add a new mapping entry for given source position with initially zero generated position   ---  addMapping (SourceSpan { spanName = file, spanStart = startPos }) = StrPos (zeroPos, mempty, [mapping])+  addMapping SourceSpan { spanName = file, spanStart = startPos } = StrPos (zeroPos, mempty, [mapping])     where       mapping = SMap file startPos zeroPos       zeroPos = SourcePos 0 0

@@ -45,11 +45,11 @@   match _ = Nothing  constraintsAsBox :: [Constraint] -> Box -> Box-constraintsAsBox [(Constraint pn tys _)] ty = text "(" <> constraintAsBox pn tys <> text ") => " <> ty-constraintsAsBox xs ty = vcat left (zipWith (\i (Constraint pn tys _) -> text (if i == 0 then "( " else ", ") <> constraintAsBox pn tys) [0 :: Int ..] xs) `before` (text ") => " <> ty)+constraintsAsBox [con] ty = text "(" <> constraintAsBox con `before` (text ") => " <> ty)+constraintsAsBox xs ty = vcat left (zipWith (\i con -> text (if i == 0 then "( " else ", ") <> constraintAsBox con) [0 :: Int ..] xs) `before` (text ") => " <> ty) -constraintAsBox :: Qualified (ProperName a) -> [Type] -> Box-constraintAsBox pn tys = hsep 1 left (text (runProperName (disqualify pn)) : map typeAtomAsBox tys)+constraintAsBox :: Constraint -> Box+constraintAsBox (Constraint pn tys _) = typeAsBox (foldl TypeApp (TypeConstructor (fmap coerceProperName pn)) tys)  -- | -- Generate a pretty-printed string representing a Row

@@ -61,7 +61,7 @@ prettyPrintValue d (Do els) =   text "do " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els) prettyPrintValue _ (TypeClassDictionary (Constraint name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys-prettyPrintValue _ (SuperClassDictionary name _) = text $ "#dict " ++ runProperName (disqualify name)+prettyPrintValue _ (DeferredDictionary name _) = text $ "#dict " ++ runProperName (disqualify name) prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =     text "#dict-accessor " <> text (runProperName (disqualify className)) <> text "." <> text (showIdent ident) <> text ">" prettyPrintValue d (TypedValue _ val _) = prettyPrintValue d val@@ -75,7 +75,6 @@ prettyPrintValue d expr@BinaryNoParens{} = prettyPrintValueAtom d expr prettyPrintValue d expr@Parens{} = prettyPrintValueAtom d expr prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr-prettyPrintValue d expr@ObjectGetter{} = prettyPrintValueAtom d expr  -- | Pretty-print an atomic expression, adding parentheses if necessary. prettyPrintValueAtom :: Int -> Expr -> Box@@ -92,7 +91,6 @@ prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")" prettyPrintValueAtom d (UnaryMinus expr) = text "(-" <> prettyPrintValue d expr <> text ")"-prettyPrintValueAtom _ (ObjectGetter field) = text "_." <> text field prettyPrintValueAtom d expr = (text "(" <> prettyPrintValue d expr) `before` text ")"  prettyPrintLiteralValue :: Int -> Literal Expr -> Box

@@ -182,10 +182,10 @@       , spacer       ] ++ spdxExamples ++       [ spacer-      , para (concat-          [ "Note that distributing code without a license means that nobody "-          , "will (legally) be able to use it."-          ])+      , para (+          "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, "@@ -420,10 +420,10 @@  warnDirtyWorkingTree :: Box warnDirtyWorkingTree =-  para (concat-    [ "Your working tree is dirty. (Note: this would be an error if it "-    , "were not a dry run)"-    ])+  para (+    "Your working tree is dirty. (Note: this would be an error if it "+    ++ "were not a dry run)"+    )  printWarnings :: [PackageWarning] -> IO () printWarnings = printToStderr . renderWarnings

@@ -142,7 +142,7 @@ renameInValue :: Expr Ann -> Rename (Expr Ann) renameInValue (Literal ann l) =   Literal ann <$> renameInLiteral renameInValue l-renameInValue c@(Constructor{}) = return c+renameInValue c@Constructor{} = return c renameInValue (Accessor ann prop v) =   Accessor ann prop <$> renameInValue v renameInValue (ObjectUpdate ann obj vs) =@@ -154,7 +154,7 @@   App ann <$> renameInValue v1 <*> renameInValue v2 renameInValue (Var ann (Qualified Nothing name)) =   Var ann . Qualified Nothing <$> lookupIdent name-renameInValue v@(Var{}) = return v+renameInValue v@Var{} = return v renameInValue (Case ann vs alts) =   newScope $ Case ann <$> traverse renameInValue vs <*> traverse renameInCaseAlternative alts renameInValue (Let ann ds v) =@@ -180,7 +180,7 @@ -- Renames within binders. -- renameInBinder :: Binder a -> Rename (Binder a)-renameInBinder n@(NullBinder{}) = return n+renameInBinder n@NullBinder{} = return n renameInBinder (LiteralBinder ann b) =   LiteralBinder ann <$> renameInLiteral renameInBinder b renameInBinder (VarBinder ann name) =

@@ -171,8 +171,8 @@     (,) (pos, bound) <$> (DataDeclaration dtype name args <$> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)   updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =     (,) (pos, bound) <$> (TypeSynonymDeclaration name ps <$> updateTypesEverywhere pos ty)-  updateDecl (pos, bound) (TypeClassDeclaration className args implies ds) =-    (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure ds)+  updateDecl (pos, bound) (TypeClassDeclaration className args implies deps ds) =+    (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure deps <*> pure ds)   updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =     (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> traverse (updateTypesEverywhere pos) ts <*> pure ds)   updateDecl (pos, bound) (TypeDeclaration name ty) =

@@ -30,7 +30,7 @@   rethrow (addHint (ErrorInModule mn)) $ foldM updateExports nullExports ds   where   updateExports :: Exports -> Declaration -> m Exports-  updateExports exps (TypeClassDeclaration tcn _ _ ds') = do+  updateExports exps (TypeClassDeclaration tcn _ _ _ ds') = do     exps' <- exportTypeClass Internal exps tcn mn     foldM go exps' ds'     where

@@ -1,5 +1,6 @@ module Language.PureScript.Sugar.ObjectWildcards   ( desugarObjectConstructors+  , desugarDecl   ) where  import Prelude.Compat@@ -21,13 +22,12 @@   => Module   -> m Module desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts-  where -  desugarDecl :: Declaration -> m Declaration-  desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d-  desugarDecl other = f other-    where-    (f, _, _) = everywhereOnValuesTopDownM return desugarExpr return+desugarDecl :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration+desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d+desugarDecl other = fn other+  where+  (fn, _, _) = everywhereOnValuesTopDownM return desugarExpr return    desugarExpr :: Expr -> m Expr   desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument@@ -45,12 +45,13 @@     obj <- freshIdent'     Abs (Left obj) <$> wrapLambda (ObjectUpdate (argToExpr obj)) ps   desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps-  desugarExpr (Accessor prop u) | isAnonymousArgument u = do-    arg <- freshIdent'-    return $ Abs (Left arg) (Accessor prop (argToExpr arg))+  desugarExpr (Accessor prop u)+    | Just props <- peelAnonAccessorChain u = do+      arg <- freshIdent'+      return $ Abs (Left arg) $ foldr Accessor (argToExpr arg) (prop:props)   desugarExpr (Case args cas) | any isAnonymousArgument args = do     argIdents <- forM args freshIfAnon-    let args' = zipWith (\p -> maybe p argToExpr) args argIdents+    let args' = zipWith (`maybe` argToExpr) args argIdents     return $ foldr (Abs . Left) (Case args' cas) (catMaybes argIdents)   desugarExpr (IfThenElse u t f) | any isAnonymousArgument [u, t, f] = do     u' <- freshIfAnon u@@ -72,6 +73,12 @@   stripPositionInfo :: Expr -> Expr   stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e   stripPositionInfo e = e++  peelAnonAccessorChain :: Expr -> Maybe [String]+  peelAnonAccessorChain (Accessor p e) = (p :) <$> peelAnonAccessorChain e+  peelAnonAccessorChain (PositionedValue _ _ e) = peelAnonAccessorChain e+  peelAnonAccessorChain AnonymousArgument = Just []+  peelAnonAccessorChain _ = Nothing    isAnonymousArgument :: Expr -> Bool   isAnonymousArgument AnonymousArgument = True

@@ -312,9 +312,9 @@   goDecl pos (ExternDeclaration name ty) = do     ty' <- goType' pos ty     return (pos, ExternDeclaration name ty')-  goDecl pos (TypeClassDeclaration name args implies decls) = do+  goDecl pos (TypeClassDeclaration name args implies deps decls) = do     implies' <- traverse (overConstraintArgs (traverse (goType' pos))) implies-    return (pos, TypeClassDeclaration name args implies' decls)+    return (pos, TypeClassDeclaration name args implies' deps decls)   goDecl pos (TypeInstanceDeclaration name cs className tys impls) = do     cs' <- traverse (overConstraintArgs (traverse (goType' pos))) cs     tys' <- traverse (goType' pos) tys@@ -332,9 +332,9 @@   goExpr pos (TypeClassDictionary (Constraint name tys info) dicts hints) = do     tys' <- traverse (goType' pos) tys     return (pos, TypeClassDictionary (Constraint name tys' info) dicts hints)-  goExpr pos (SuperClassDictionary cls tys) = do+  goExpr pos (DeferredDictionary cls tys) = do     tys' <- traverse (goType' pos) tys-    return (pos, SuperClassDictionary cls tys')+    return (pos, DeferredDictionary cls tys')   goExpr pos (TypedValue check v ty) = do     ty' <- goType' pos ty     return (pos, TypedValue check v ty')

@@ -28,12 +28,12 @@ parseValue = token (either Just (const Nothing)) P.<?> "expression"  parseOp-  :: (a -> (Maybe (Qualified (OpName nameType))))+  :: (a -> Maybe (Qualified (OpName nameType)))   -> P.Parsec (Chain a) () (Qualified (OpName nameType)) parseOp fromOp = token (either (const Nothing) fromOp) P.<?> "operator"  matchOp-  :: (a -> (Maybe (Qualified (OpName nameType))))+  :: (a -> Maybe (Qualified (OpName nameType)))   -> Qualified (OpName nameType)   -> P.Parsec (Chain a) () () matchOp fromOp op = do

@@ -28,7 +28,7 @@   fromOp _ = Nothing    reapply :: Qualified (OpName 'ValueOpName) -> Expr -> Expr -> Expr-  reapply op t1 t2 = App (App (Op op) t1) t2+  reapply op t1 = App (App (Op op) t1)    modOpTable     :: [[P.Operator (Chain Expr) () Identity Expr]]

@@ -30,7 +30,7 @@  import qualified Data.Map as M -type MemberMap = M.Map (ModuleName, ProperName 'ClassName) ([(String, Maybe Kind)], [Constraint], [Declaration])+type MemberMap = M.Map (ModuleName, ProperName 'ClassName) TypeClassData  type Desugar = StateT MemberMap @@ -46,14 +46,20 @@ desugarTypeClasses externs = flip evalStateT initialState . traverse desugarModule   where   initialState :: MemberMap-  initialState = M.singleton (ModuleName [ProperName C.prim], ProperName C.partial) ([], [], [])-       `M.union` M.fromList (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)+  initialState =+    M.mapKeys (qualify (ModuleName [ProperName C.prim])) primClasses+    `M.union` M.fromList (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)    fromExternsDecl     :: ModuleName     -> ExternsDeclaration-    -> Maybe ((ModuleName, ProperName 'ClassName), ([(String, Maybe Kind)], [Constraint], [Declaration]))-  fromExternsDecl mn (EDClass name args members implies) = Just ((mn, name), (args, implies, map (uncurry TypeDeclaration) members))+    -> Maybe ((ModuleName, ProperName 'ClassName), TypeClassData)+  fromExternsDecl mn (EDClass name args members implies deps) = Just ((mn, name), typeClass) where+    typeClass = TypeClassData { typeClassArguments    = args+                              , typeClassMembers      = members+                              , typeClassSuperclasses = implies+                              , typeClassDependencies = deps+                              }   fromExternsDecl _ _ = Nothing  desugarModule@@ -129,7 +135,7 @@ -- --   subString :: {} -> Sub String --   subString _ = { sub: "",---                 , "__superclass_Foo_0": \_ -> <SuperClassDictionary Foo String>+--                 , "__superclass_Foo_0": \_ -> <DeferredDictionary Foo String> --                 } -- -- and finally as the generated javascript:@@ -173,14 +179,18 @@   -> Desugar m (Maybe DeclarationRef, [Declaration]) desugarDecl mn exps = go   where-  go d@(TypeClassDeclaration name args implies members) = do-    modify (M.insert (mn, name) (args, implies, members))+  go d@(TypeClassDeclaration name args implies deps members) = do+    modify (M.insert (mn, name) (TypeClassData args (map memberToNameAndType members) implies deps))     return (Nothing, d : typeClassDictionaryDeclaration name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)   go (TypeInstanceDeclaration _ _ _ _ DerivedInstance) = internalError "Derived instanced should have been desugared"   go d@(TypeInstanceDeclaration name deps className tys (ExplicitInstance members)) = do     desugared <- desugarCases members     dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared     return (expRef name className tys, [d, dictDecl])+  go d@(TypeInstanceDeclaration name deps className tys (NewtypeInstanceWithDictionary dict)) = do+    let dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys+        constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)+    return (expRef name className tys, [d, ValueDeclaration name Private [] (Right (TypedValue True dict constrainedTy))])   go (PositionedDeclaration pos com d) = do     (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn exps d     return (dr, map (PositionedDeclaration pos com) ds)@@ -267,18 +277,15 @@   m <- get    -- Lookup the type arguments and member types for the type class-  (args, implies, tyDecls) <-+  TypeClassData{..} <-     maybe (throwError . errorMessage . UnknownName $ fmap TyClassName className) return $       M.lookup (qualify mn className) m -  case mapMaybe declName tyDecls \\ mapMaybe declName decls of+  case map fst typeClassMembers \\ mapMaybe declName decls of     member : _ -> throwError . errorMessage $ MissingClassMember member     [] -> do--      let instanceTys = map memberToNameAndType tyDecls-       -- Replace the type arguments with the appropriate types in the member types-      let memberTypes = map (second (replaceAllTypeVars (zip (map fst args) tys))) instanceTys+      let memberTypes = map (second (replaceAllTypeVars (zip (map fst typeClassArguments) tys))) typeClassMembers        -- Create values for the type instance members       members <- zip (map typeClassMemberName decls) <$> traverse (memberToValue memberTypes) decls@@ -286,10 +293,10 @@       -- 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 implies `zip`-            [ Abs (Left (Ident C.__unused)) (SuperClassDictionary superclass tyArgs)-            | (Constraint superclass suTyArgs _) <- implies-            , let tyArgs = map (replaceAllTypeVars (zip (map fst args) tys)) suTyArgs+      let superclasses = superClassDictionaryNames typeClassSuperclasses `zip`+            [ Abs (Left (Ident C.__unused)) (DeferredDictionary superclass tyArgs)+            | (Constraint superclass suTyArgs _) <- typeClassSuperclasses+            , let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs             ]        let props = Literal $ ObjectLiteral (members ++ superclasses)

@@ -22,6 +22,7 @@ import Language.PureScript.Errors import Language.PureScript.Names import Language.PureScript.Types+import Language.PureScript.TypeChecker (checkNewtype) import qualified Language.PureScript.Constants as C  -- | Elaborates deriving instance declarations by code generation.@@ -44,16 +45,29 @@   , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty   , mn == fromMaybe mn mn'   = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn ds tyCon args-  | className == Qualified (Just (ModuleName [ ProperName "Data", ProperName "Eq" ])) (ProperName "Eq")+  | className == Qualified (Just dataEq) (ProperName "Eq")   , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty   , mn == fromMaybe mn mn'   = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveEq mn ds tyCon-  | className == Qualified (Just (ModuleName [ ProperName "Data", ProperName "Ord" ])) (ProperName "Ord")+  | className == Qualified (Just dataOrd) (ProperName "Ord")   , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty   , mn == fromMaybe mn mn'   = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveOrd mn ds tyCon+deriveInstance mn ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwrappedTy] DerivedInstance)+  | className == Qualified (Just dataNewtype) (ProperName "Newtype")+  , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor wrappedTy+  , mn == fromMaybe mn mn'+  = do+    (inst, actualUnwrappedTy) <- deriveNewtype mn ds tyCon unwrappedTy+    return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst) deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)   = throwError . errorMessage $ CannotDerive className tys+deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@(_ : _) NewtypeInstance)+  | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)+  , mn == fromMaybe mn mn'+  = TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance className ds tys tyCon args+deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys NewtypeInstance)+  = throwError . errorMessage $ InvalidNewtypeInstance className tys deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d deriveInstance _  _  e = return e @@ -66,6 +80,25 @@     return (tyCon, arg : args)   go _ = Nothing +deriveNewtypeInstance+  :: forall m+   . MonadError MultipleErrors m+  => Qualified (ProperName 'ClassName)+  -> [Declaration]+  -> [Type]+  -> ProperName 'TypeName+  -> [Type]+  -> m Expr+deriveNewtypeInstance className ds tys tyConNm dargs = do+    tyCon <- findTypeDecl tyConNm ds+    go tyCon+  where+    go (DataDeclaration Newtype _ tyArgNames [(_, [wrapped])]) = do+      let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs+      return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped]))+    go (PositionedDeclaration _ _ d) = go d+    go _ = throwError . errorMessage $ InvalidNewtypeInstance className tys+ dataGeneric :: ModuleName dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ] @@ -75,6 +108,15 @@ typesProxy :: ModuleName typesProxy = ModuleName [ ProperName "Type", ProperName "Proxy" ] +dataEq :: ModuleName+dataEq = ModuleName [ ProperName "Data", ProperName "Eq" ]++dataOrd :: ModuleName+dataOrd = ModuleName [ ProperName "Data", ProperName "Ord" ]++dataNewtype :: ModuleName+dataNewtype = ModuleName [ ProperName "Data", ProperName "Newtype" ]+ deriveGeneric   :: forall m. (MonadError MultipleErrors m, MonadSupply m)   => ModuleName@@ -223,7 +265,7 @@           $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar (Ident x))) y) rs)        mkRecFun :: [(String, Type)] -> Expr-      mkRecFun xs = mkJust $ foldr lam recLiteral (map (Ident . fst) xs)+      mkRecFun xs = mkJust $ foldr (lam . Ident . fst) recLiteral xs          where recLiteral = Literal . ObjectLiteral $ map (\(s,_) -> (s, mkVar (Ident s))) xs     mkFromSpineFunction (PositionedDeclaration _ _ d) = mkFromSpineFunction d     mkFromSpineFunction _ = internalError "mkFromSpineFunction: expected DataDeclaration"@@ -265,7 +307,7 @@     preludeConj = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "HeytingAlgebra"])) (Ident C.conj)))      preludeEq :: Expr -> Expr -> Expr-    preludeEq = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Eq"])) (Ident C.eq)))+    preludeEq = App . App (Var (Qualified (Just dataEq) (Ident C.eq)))      addCatch :: [CaseAlternative] -> [CaseAlternative]     addCatch xs@@ -335,7 +377,7 @@     orderingBinder name = ConstructorBinder (orderingName name) []      ordCompare :: Expr -> Expr -> Expr-    ordCompare = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Ord"])) (Ident C.compare)))+    ordCompare = App . App (Var (Qualified (Just dataOrd) (Ident C.compare)))      mkCtorClauses :: ((ProperName 'ConstructorName, [Type]), Bool) -> m [CaseAlternative]     mkCtorClauses ((ctorName, tys), isLast) = do@@ -378,6 +420,47 @@       . map (\(str, typ) -> toOrdering (Accessor str l) (Accessor str r) typ)       $ decomposeRec rec     toOrdering l r _ = ordCompare l r++deriveNewtype+  :: forall m+   . (MonadError MultipleErrors m, MonadSupply m)+  => ModuleName+  -> [Declaration]+  -> ProperName 'TypeName+  -> Type+  -> m ([Declaration], Type)+deriveNewtype mn ds tyConNm unwrappedTy = do+  checkIsWildcard unwrappedTy+  go =<< findTypeDecl tyConNm ds+  where++  go :: Declaration -> m ([Declaration], Type)+  go (DataDeclaration Data name _ _) =+    throwError . errorMessage $ CannotDeriveNewtypeForData name+  go (DataDeclaration Newtype name _ dctors) = do+    checkNewtype name dctors+    let (ctorName, [ty]) = head dctors+    wrappedIdent <- freshIdent "n"+    unwrappedIdent <- freshIdent "a"+    let inst =+          [ ValueDeclaration (Ident "wrap") Public [] $ Right $+              Constructor (Qualified (Just mn) ctorName)+          , ValueDeclaration (Ident "unwrap") Public [] $ Right $+              lamCase wrappedIdent+                [ CaseAlternative+                    [ConstructorBinder (Qualified (Just mn) ctorName) [VarBinder unwrappedIdent]]+                    (Right (Var (Qualified Nothing unwrappedIdent)))+                ]+          ]+    return (inst, ty)+  go (PositionedDeclaration _ _ d) = go d+  go _ = internalError "deriveNewtype go: expected DataDeclaration"++  checkIsWildcard :: Type -> m ()+  checkIsWildcard (TypeWildcard _) =+    return ()+  checkIsWildcard _ =+    throwError . errorMessage $ NonWildcardNewtypeInstance tyConNm  findTypeDecl   :: (MonadError MultipleErrors m)

@@ -6,6 +6,7 @@ module Language.PureScript.TypeChecker   ( module T   , typeCheckModule+  , checkNewtype   ) where  import Prelude.Compat@@ -112,16 +113,24 @@   -> ProperName 'ClassName   -> [(String, Maybe Kind)]   -> [Constraint]+  -> [FunctionalDependency]   -> [Declaration]   -> m ()-addTypeClass moduleName pn args implies ds =-  let members = map toPair ds in-  modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert (Qualified (Just moduleName) pn) (args, members, implies) (typeClasses . checkEnv $ st) } }+addTypeClass moduleName pn args implies dependencies ds =+    modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert (Qualified (Just moduleName) pn) newClass (typeClasses . checkEnv $ st) } }   where-  toPair (TypeDeclaration ident ty) = (ident, ty)-  toPair (PositionedDeclaration _ _ d) = toPair d-  toPair _ = internalError "Invalid declaration in TypeClassDeclaration"+    newClass :: TypeClassData+    newClass =+      TypeClassData { typeClassArguments    = args+                    , typeClassMembers      = map toPair ds+                    , typeClassSuperclasses = implies+                    , typeClassDependencies = dependencies+                    } +    toPair (TypeDeclaration ident ty) = (ident, ty)+    toPair (PositionedDeclaration _ _ d) = toPair d+    toPair _ = internalError "Invalid declaration in TypeClassDeclaration"+ addTypeClassDictionaries   :: (MonadState CheckState m)   => Maybe ModuleName@@ -265,8 +274,8 @@     return d   go d@FixityDeclaration{} = return d   go d@ImportDeclaration{} = return d-  go d@(TypeClassDeclaration pn args implies tys) = do-    addTypeClass moduleName pn args implies tys+  go d@(TypeClassDeclaration pn args implies deps tys) = do+    addTypeClass moduleName pn args implies deps tys     return d   go (d@(TypeInstanceDeclaration dictName deps className tys body)) = rethrow (addHint (ErrorInInstance className tys)) $ do     traverse_ (checkTypeClassInstance moduleName) tys@@ -310,10 +319,6 @@     checkType _ = internalError "Invalid type in instance in checkOrphanInstance"   checkOrphanInstance _ _ _ = internalError "Unqualified class name in checkOrphanInstance" -  checkNewtype :: ProperName 'TypeName -> [(ProperName 'ConstructorName, [Type])] -> m ()-  checkNewtype _ [(_, [_])] = return ()-  checkNewtype name _ = throwError . errorMessage $ InvalidNewtype name-   -- |   -- 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.@@ -324,6 +329,15 @@   withKinds (  (s, Nothing):ss) (FunKind k1 k2) = (s, Just k1) : withKinds ss k2   withKinds _                   _               = internalError "Invalid arguments to peelKinds" +checkNewtype+  :: forall m+   . MonadError MultipleErrors m+  => ProperName 'TypeName+  -> [(ProperName 'ConstructorName, [Type])]+  -> m ()+checkNewtype _ [(_, [_])] = return ()+checkNewtype name _ = throwError . errorMessage $ InvalidNewtype name+ -- | -- Type check an entire module and ensure all types and classes defined within the module that are -- required by exported members are also exported.@@ -414,7 +428,7 @@     unless (null missingMembers) $ throwError . errorMessage $ TransitiveExportError dr members     where     findClassMembers :: Declaration -> Maybe [Ident]-    findClassMembers (TypeClassDeclaration name' _ _ ds) | name == name' = Just $ map extractMemberName ds+    findClassMembers (TypeClassDeclaration name' _ _ _ ds) | name == name' = Just $ map extractMemberName ds     findClassMembers (PositionedDeclaration _ _ d) = findClassMembers d     findClassMembers _ = Nothing     extractMemberName :: Declaration -> Ident

@@ -1,28 +1,35 @@+{-# LANGUAGE NamedFieldPuns #-}+ -- | -- Type class entailment -- module Language.PureScript.TypeChecker.Entailment   ( InstanceContext   , replaceTypeClassDictionaries+  , newDictionaries   ) where  import Prelude.Compat +import Control.Arrow (second) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State import Control.Monad.Supply.Class (MonadSupply(..)) import Control.Monad.Writer +import Data.Foldable (for_) import Data.Function (on)-import Data.List (minimumBy, sortBy, groupBy)-import Data.Maybe (maybeToList, mapMaybe)+import Data.List (minimumBy, nub)+import Data.Maybe (fromMaybe, maybeToList, mapMaybe) import qualified Data.Map as M+import qualified Data.Set as S  import Language.PureScript.AST import Language.PureScript.Crash+import Language.PureScript.Environment import Language.PureScript.Errors import Language.PureScript.Names-import Language.PureScript.TypeChecker.Monad (CheckState, withErrorMessageHint)+import Language.PureScript.TypeChecker.Monad import Language.PureScript.TypeChecker.Unify import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types@@ -34,25 +41,58 @@                            (M.Map (Qualified Ident)                              TypeClassDictionaryInScope)) --- | Merge two type class contexts+-- | A type substitution which makes an instance head match a list of types.+--+-- Note: we store many types per type variable name. For any name, all types+-- should unify if we are going to commit to an instance.+type Matching a = M.Map String a+ combineContexts :: InstanceContext -> InstanceContext -> InstanceContext combineContexts = M.unionWith (M.unionWith M.union)  -- | Replace type class dictionary placeholders with inferred type class dictionaries replaceTypeClassDictionaries-  :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)+  :: forall m+   . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => Bool-  -> ModuleName   -> Expr   -> m (Expr, [(Ident, Constraint)])-replaceTypeClassDictionaries shouldGeneralize mn =-  let (_, f, _) = everywhereOnValuesTopDownM return (WriterT . go) return-  in flip evalStateT M.empty . runWriterT . f+replaceTypeClassDictionaries shouldGeneralize expr = flip evalStateT M.empty $ do+    -- Loop, deferring any unsolved constraints, until there are no more+    -- constraints which can be solved, then make a generalization pass.+    let loop e = do+          (e', solved) <- deferPass e+          if getAny solved+            then loop e'+            else return e'+    loop expr >>= generalizePass   where-  go (TypeClassDictionary constraint dicts hints) =-    rethrow (addHints hints) $ entails shouldGeneralize mn dicts constraint-  go other = return (other, [])+    -- This pass solves constraints where possible, deferring constraints if not.+    deferPass :: Expr -> StateT InstanceContext m (Expr, Any)+    deferPass = fmap (second fst) . runWriterT . f where+      f :: Expr -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr+      (_, f, _) = everywhereOnValuesTopDownM return (go True) return +    -- This pass generalizes any remaining constraints+    generalizePass :: Expr -> StateT InstanceContext m (Expr, [(Ident, Constraint)])+    generalizePass = fmap (second snd) . runWriterT . f where+      f :: Expr -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr+      (_, f, _) = everywhereOnValuesTopDownM return (go False) return++    go :: Bool -> Expr -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr+    go deferErrors dict@(TypeClassDictionary _ _ hints) =+      rethrow (addHints hints) $ entails shouldGeneralize deferErrors dict+    go _ other = return other++-- | Three options for how we can handle a constraint, depending on the mode we're in.+data EntailsResult a+  = Solved a TypeClassDictionaryInScope+  -- ^ We solved this constraint+  | Unsolved Constraint+  -- ^ We couldn't solve this constraint right now, it will be generalized+  | Deferred+  -- ^ We couldn't solve this constraint right now, so it has been deferred+ -- | -- Check that the current set of type class dictionaries entail the specified type class goal, and, if so, -- return a type class dictionary reference.@@ -61,14 +101,14 @@   :: forall m    . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)   => Bool-  -> ModuleName-  -> InstanceContext-  -> Constraint-  -> StateT InstanceContext m (Expr, [(Ident, Constraint)])-entails shouldGeneralize moduleName context = solve+  -> Bool+  -> Expr+  -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr+entails shouldGeneralize deferErrors (TypeClassDictionary constraint context hints) =+    solve constraint   where     forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDictionaryInScope]-    forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))+    forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (nub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))     forClassName _ _ _ = internalError "forClassName: expected qualified class name"      ctorModules :: Type -> Maybe ModuleName@@ -80,139 +120,306 @@     findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDictionaryInScope]     findDicts ctx cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx -    solve :: Constraint -> StateT InstanceContext m (Expr, [(Ident, Constraint)])-    solve con = StateT . (withErrorMessageHint (ErrorSolvingConstraint con) .) . runStateT $ do-      (dict, unsolved) <- go 0 con-      return (dictionaryValueToValue dict, unsolved)+    valUndefined :: Expr+    valUndefined = Var (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))++    solve :: Constraint -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr+    solve con = go 0 con       where-      go :: Int -> Constraint -> StateT InstanceContext m (DictionaryValue, [(Ident, Constraint)])-      go work (Constraint className' tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'-      go work con'@(Constraint className' tys' _) = do-        -- Get the inferred constraint context so far, and merge it with the global context-        inferred <- get-        let instances = do-              tcd <- forClassName (combineContexts context inferred) className' tys'-              -- Make sure the type unifies with the type in the type instance definition-              subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName) tys' (tcdInstanceTypes tcd)-              return (subst, tcd)-        solution <- lift $ unique instances-        case solution of-          Left (subst, tcd) -> do-            -- Solve any necessary subgoals-            (args, unsolved) <- solveSubgoals subst (tcdDependencies tcd)-            let match = foldr (\(superclassName, index) dict -> SubclassDictionaryValue dict superclassName index)-                              (mkDictionary (tcdName tcd) args)-                              (tcdPath tcd)-            return (match, unsolved)-          Right unsolved@(Constraint unsolvedClassName@(Qualified _ pn) unsolvedTys _) -> do-            -- Generate a fresh name for the unsolved constraint's new dictionary-            ident <- freshIdent ("dict" ++ runProperName pn)-            let qident = Qualified Nothing ident-            -- Store the new dictionary in the InstanceContext so that we can solve this goal in-            -- future.-            let newDict = TypeClassDictionaryInScope qident [] unsolvedClassName unsolvedTys Nothing-                newContext = M.singleton Nothing (M.singleton unsolvedClassName (M.singleton qident newDict))-            modify (combineContexts newContext)-            return (LocalDictionaryValue qident, [(ident, unsolved)])-        where+        go :: Int -> Constraint -> WriterT (Any, [(Ident, Constraint)]) (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+            -- 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'+            -- 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:+            let findClass = fromMaybe (internalError "entails: type class not found in environment") . M.lookup className'+            TypeClassData{ typeClassDependencies } <- lift . lift $ gets (findClass . typeClasses . checkEnv)+            let instances =+                  [ (substs, tcd)+                  | tcd <- forClassName (combineContexts context inferred) className' tys''+                    -- Make sure the type unifies with the type in the type instance definition+                  , substs <- maybeToList (matches typeClassDependencies tcd tys'')+                  ]+            solution <- lift . lift $ unique tys'' instances+            case solution of+              Solved substs tcd -> do+                -- Note that we solved something.+                tell (Any True, mempty)+                -- Make sure the substitution is valid:+                lift . lift . for_ substs $ pairwiseM unifyTypes+                -- Now enforce any functional dependencies, using unification+                -- Note: we need to generate fresh types for any unconstrained+                -- type variables before unifying.+                let subst = fmap head substs+                currentSubst <- lift . lift $ gets checkSubstitution+                subst' <- lift . lift $ withFreshTypes tcd (fmap (substituteType currentSubst) subst)+                lift . lift $ zipWithM_ (\t1 t2 -> do+                  let inferredType = replaceAllTypeVars (M.toList subst') t1+                  unifyTypes inferredType t2) (tcdInstanceTypes tcd) tys''+                currentSubst' <- lift . lift $ gets checkSubstitution+                let subst'' = fmap (substituteType currentSubst') subst'+                -- Solve any necessary subgoals+                args <- solveSubgoals subst'' (tcdDependencies tcd)+                let match = foldr (\(superclassName, index) dict -> subclassDictionaryValue dict superclassName index)+                                  (mkDictionary (tcdName tcd) args)+                                  (tcdPath tcd)+                return match+              Unsolved unsolved -> do+                -- Generate a fresh name for the unsolved constraint's new dictionary+                ident <- freshIdent ("dict" ++ runProperName (disqualify (constraintClass unsolved)))+                let qident = Qualified Nothing ident+                -- Store the new dictionary in the InstanceContext so that we can solve this goal in+                -- future.+                newDicts <- lift . lift $ newDictionaries [] qident unsolved+                let newContext = mkContext newDicts+                modify (combineContexts newContext)+                -- Mark this constraint for generalization+                tell (mempty, [(ident, unsolved)])+                return (Var qident)+              Deferred ->+                -- Constraint was deferred, just return the dictionary unchanged,+                -- with no unsolved constraints. Hopefully, we can solve this later.+                return (TypeClassDictionary (Constraint className' 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.+            -- 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+            -- Int. This is fine, but in some cases, the substitution does not remove all TypeVars+            -- 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.+            withFreshTypes+              :: TypeClassDictionaryInScope+              -> Matching Type+              -> m (Matching Type)+            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)+              where+                fromTypeVar (TypeVar v) = S.singleton v+                fromTypeVar _ = S.empty -        unique :: [(a, TypeClassDictionaryInScope)] -> m (Either (a, TypeClassDictionaryInScope) Constraint)-        unique [] | shouldGeneralize && all canBeGeneralized tys' = return (Right con')-                  | otherwise = throwError . errorMessage $ NoInstanceFound con'-        unique [a] = return $ Left a-        unique tcds | pairwise overlapping (map snd tcds) = do-                        tell . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) tcds)-                        return $ Left (head tcds)-                    | otherwise = return $ Left (minimumBy (compare `on` length . tcdPath . snd) tcds)+                withFreshType s = do+                  t <- freshType+                  return (s, t) -        canBeGeneralized :: Type -> Bool-        canBeGeneralized TUnknown{} = True-        canBeGeneralized Skolem{} = True-        canBeGeneralized _ = False+            unique :: [Type] -> [(a, TypeClassDictionaryInScope)] -> m (EntailsResult a)+            unique tyArgs []+              | deferErrors = return Deferred+              -- We need a special case for nullary type classes, since we want+              -- to generalize over Partial constraints.+              | shouldGeneralize && (null tyArgs || any canBeGeneralized tyArgs) = return (Unsolved (Constraint className' tyArgs conInfo))+              | otherwise = throwError . errorMessage $ NoInstanceFound (Constraint className' tyArgs conInfo)+            unique _      [(a, dict)] = return $ Solved a dict+            unique tyArgs tcds+              | pairwiseAny overlapping (map snd tcds) = do+                  tell . errorMessage $ OverlappingInstances className' tyArgs (map (tcdName . snd) tcds)+                  return $ uncurry Solved (head tcds)+              | otherwise = return $ uncurry Solved (minimumBy (compare `on` length . tcdPath . snd) tcds) -        -- |-        -- Check if two dictionaries are overlapping-        ---        -- Dictionaries which are subclass dictionaries cannot overlap, since otherwise the overlap would have-        -- been caught when constructing superclass dictionaries.-        overlapping :: TypeClassDictionaryInScope -> TypeClassDictionaryInScope -> Bool-        overlapping TypeClassDictionaryInScope{ tcdPath = _ : _ } _ = False-        overlapping _ TypeClassDictionaryInScope{ tcdPath = _ : _ } = False-        overlapping TypeClassDictionaryInScope{ tcdDependencies = Nothing } _ = False-        overlapping _ TypeClassDictionaryInScope{ tcdDependencies = Nothing } = False-        overlapping tcd1 tcd2 = tcdName tcd1 /= tcdName tcd2+            canBeGeneralized :: Type -> Bool+            canBeGeneralized TUnknown{} = True+            canBeGeneralized Skolem{} = True+            canBeGeneralized _ = False -        -- Create dictionaries for subgoals which still need to be solved by calling go recursively-        -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type-        -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.-        solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> StateT InstanceContext m (Maybe [DictionaryValue], [(Ident, Constraint)])-        solveSubgoals _ Nothing = return (Nothing, [])-        solveSubgoals subst (Just subgoals) = do-          zipped <- traverse (go (work + 1) . mapConstraintArgs (map (replaceAllTypeVars subst))) subgoals-          let (dicts, unsolved) = unzip zipped-          return (Just dicts, concat unsolved)+            -- |+            -- Check if two dictionaries are overlapping+            --+            -- Dictionaries which are subclass dictionaries cannot overlap, since otherwise the overlap would have+            -- been caught when constructing superclass dictionaries.+            overlapping :: TypeClassDictionaryInScope -> TypeClassDictionaryInScope -> Bool+            overlapping TypeClassDictionaryInScope{ tcdPath = _ : _ } _ = False+            overlapping _ TypeClassDictionaryInScope{ tcdPath = _ : _ } = False+            overlapping TypeClassDictionaryInScope{ tcdDependencies = Nothing } _ = False+            overlapping _ TypeClassDictionaryInScope{ tcdDependencies = Nothing } = False+            overlapping tcd1 tcd2 = tcdName tcd1 /= tcdName tcd2 -        -- Make a dictionary from subgoal dictionaries by applying the correct function-        mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue-        mkDictionary fnName Nothing = LocalDictionaryValue fnName-        mkDictionary fnName (Just []) = GlobalDictionaryValue fnName-        mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts+            -- Create dictionaries for subgoals which still need to be solved by calling go recursively+            -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type+            -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.+            solveSubgoals :: Matching Type -> Maybe [Constraint] -> WriterT (Any, [(Ident, Constraint)]) (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 -      -- Turn a DictionaryValue into a Expr-      dictionaryValueToValue :: DictionaryValue -> Expr-      dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName-      dictionaryValueToValue (GlobalDictionaryValue fnName) = Var fnName-      dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)-      dictionaryValueToValue (SubclassDictionaryValue dict superclassName index) =-        App (Accessor (C.__superclass_ ++ showQualified runProperName superclassName ++ "_" ++ show index)-                      (dictionaryValueToValue dict))-            valUndefined-      -- Ensure that a substitution is valid-      verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]-      verifySubstitution subst = do-        let grps = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ subst-        guard (all (pairwise unifiesWith . map snd) grps)-        return $ map head grps+            -- Make a dictionary from subgoal dictionaries by applying the correct function+            mkDictionary :: Qualified Ident -> Maybe [Expr] -> Expr+            mkDictionary fnName Nothing = Var fnName+            mkDictionary fnName (Just []) = Var fnName+            mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts -    valUndefined :: Expr-    valUndefined = Var (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))+        -- Turn a DictionaryValue into a Expr+        subclassDictionaryValue :: Expr -> Qualified (ProperName a) -> Integer -> Expr+        subclassDictionaryValue dict superclassName index =+          App (Accessor (C.__superclass_ ++ showQualified runProperName superclassName ++ "_" ++ show index)+                        dict)+              valUndefined+entails _ _ _ = internalError "entails: expected TypeClassDictionary" --- |--- Check whether the type heads of two types are equal (for the purposes of type class dictionary lookup),--- and return a substitution from type variables to types which makes the type heads unify.----typeHeadsAreEqual :: ModuleName -> Type -> Type -> Maybe [(String, Type)]-typeHeadsAreEqual _ (TUnknown u1)        (TUnknown u2)        | u1 == u2 = Just []-typeHeadsAreEqual _ (Skolem _ s1 _ _)    (Skolem _ s2 _ _)    | s1 == s2 = Just []-typeHeadsAreEqual _ t                    (TypeVar v)                     = Just [(v, t)]-typeHeadsAreEqual _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []-typeHeadsAreEqual _ (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = Just []-typeHeadsAreEqual m (TypeApp h1 t1)      (TypeApp h2 t2)                 = (++) <$> typeHeadsAreEqual m h1 h2-                                                                                <*> typeHeadsAreEqual m t1 t2-typeHeadsAreEqual _ REmpty REmpty = Just []-typeHeadsAreEqual m r1@RCons{} r2@RCons{} =-  let (s1, r1') = rowToList r1-      (s2, r2') = rowToList r2+-- 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+-- substitution which makes them match. If not, we return 'Nothing'.+matches :: [FunctionalDependency] -> TypeClassDictionaryInScope -> [Type] -> Maybe (Matching [Type])+matches deps TypeClassDictionaryInScope{..} tys = do+    -- First, find those types which match exactly+    let matched = zipWith typeHeadsAreEqual tys tcdInstanceTypes+    -- Now, use any functional dependencies to infer any remaining types+    guard $ covers matched+    -- Verify that any repeated type variables are unifiable+    let determinedSet = foldMap (S.fromList . fdDetermined) deps+        solved = map snd . filter ((`S.notMember` determinedSet) . fst) $ zipWith (\(_, ts) i -> (i, ts)) matched [0..]+    verifySubstitution (M.unionsWith (++) solved)+  where+    -- | Find the closure of a set of functional dependencies.+    covers :: [(Bool, subst)] -> Bool+    covers ms = finalSet == S.fromList [0..length ms - 1]+      where+        initialSet :: S.Set Int+        initialSet = S.fromList . map snd . filter (fst . fst) $ zip ms [0..] -      int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]-      sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]-      sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]-  in (++) <$> foldMap (uncurry (typeHeadsAreEqual m)) int-          <*> go sd1 r1' sd2 r2'+        finalSet :: S.Set Int+        finalSet = untilFixedPoint applyAll initialSet++        untilFixedPoint :: Eq a => (a -> a) -> a -> a+        untilFixedPoint f = go+          where+          go a | a' == a = a'+               | otherwise = go a'+            where a' = f a++        applyAll :: S.Set Int -> S.Set Int+        applyAll s = foldr applyDependency s deps++        applyDependency :: FunctionalDependency -> S.Set Int -> S.Set Int+        applyDependency FunctionalDependency{..} xs+          | S.fromList fdDeterminers `S.isSubsetOf` xs = xs <> S.fromList fdDetermined+          | otherwise = xs++    --+    -- Check whether the type heads of two types are equal (for the purposes of type class dictionary lookup),+    -- and return a substitution from type variables to types which makes the type heads unify.+    --+    typeHeadsAreEqual :: Type -> Type -> (Bool, Matching [Type])+    typeHeadsAreEqual (TUnknown u1)        (TUnknown u2)        | u1 == u2 = (True, M.empty)+    typeHeadsAreEqual (Skolem _ s1 _ _)    (Skolem _ s2 _ _)    | s1 == s2 = (True, M.empty)+    typeHeadsAreEqual t                    (TypeVar v)                     = (True, M.singleton v [t])+    typeHeadsAreEqual (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = (True, M.empty)+    typeHeadsAreEqual (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = (True, M.empty)+    typeHeadsAreEqual (TypeApp h1 t1)      (TypeApp h2 t2)                 =+      both (typeHeadsAreEqual h1 h2) (typeHeadsAreEqual t1 t2)+    typeHeadsAreEqual REmpty REmpty = (True, M.empty)+    typeHeadsAreEqual r1@RCons{} r2@RCons{} =+        foldr both (go sd1 r1' sd2 r2') (map (uncurry typeHeadsAreEqual) int)+      where+        (s1, r1') = rowToList r1+        (s2, r2') = rowToList r2++        int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]+        sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]+        sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]++        go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> (Bool, Matching [Type])+        go [] REmpty             [] REmpty             = (True, M.empty)+        go [] (TUnknown u1)      [] (TUnknown u2)      | u1 == u2 = (True, M.empty)+        go [] (TypeVar v1)       [] (TypeVar v2)       | v1 == v2 = (True, M.empty)+        go [] (Skolem _ sk1 _ _) [] (Skolem _ sk2 _ _) | sk1 == sk2 = (True, M.empty)+        go sd r                  [] (TypeVar v)        = (True, M.singleton v [rowFromList (sd, r)])+        go _  _                  _  _                  = (False, M.empty)+    typeHeadsAreEqual _ _ = (False, M.empty)++    both :: (Bool, Matching [Type]) -> (Bool, Matching [Type]) -> (Bool, Matching [Type])+    both (b1, m1) (b2, m2) = (b1 && b2, M.unionWith (++) m1 m2)++    -- Ensure that a substitution is valid+    verifySubstitution :: Matching [Type] -> Maybe (Matching [Type])+    verifySubstitution = traverse meet where+      meet ts | pairwiseAll typesAreEqual ts = Just ts+              | otherwise = Nothing++      -- Note that unknowns are only allowed to unify if they came from a type+      -- which was _not_ solved, i.e. one which was inferred by a functional+      -- dependency.+      typesAreEqual :: Type -> Type -> Bool+      typesAreEqual (TUnknown u1)        (TUnknown u2)        | u1 == u2 = True+      typesAreEqual (Skolem _ s1 _ _)    (Skolem _ s2 _ _)    = s1 == s2+      typesAreEqual (TypeVar v1)         (TypeVar v2)         = v1 == v2+      typesAreEqual (TypeLevelString s1) (TypeLevelString s2) = s1 == s2+      typesAreEqual (TypeConstructor c1) (TypeConstructor c2) = c1 == c2+      typesAreEqual (TypeApp h1 t1)      (TypeApp h2 t2)      = typesAreEqual h1 h2 && typesAreEqual t1 t2+      typesAreEqual REmpty               REmpty               = True+      typesAreEqual r1                   r2                   | isRCons r1 || isRCons r2 =+          let (s1, r1') = rowToList r1+              (s2, r2') = rowToList r2++              int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]+              sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]+              sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]+          in all (uncurry typesAreEqual) int && go sd1 r1' sd2 r2'+        where+          go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool+          go [] (TUnknown u1)     [] (TUnknown u2)     | u1 == u2 = True+          go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2+          go [] REmpty            [] REmpty            = True+          go [] (TypeVar v1)      [] (TypeVar v2)      = v1 == v2+          go _  _                 _  _                 = False+      typesAreEqual _ _ = False++      isRCons :: Type -> Bool+      isRCons RCons{}    = True+      isRCons _          = False++-- | Add a dictionary for the constraint to the scope, and dictionaries+-- for all implied superclass instances.+newDictionaries+  :: MonadState CheckState m+  => [(Qualified (ProperName 'ClassName), Integer)]+  -> Qualified Ident+  -> Constraint+  -> m [TypeClassDictionaryInScope]+newDictionaries path name (Constraint className instanceTy _) = do+    tcs <- gets (typeClasses . checkEnv)+    let TypeClassData{..} = fromMaybe (internalError "newDictionaries: type class lookup failed") $ M.lookup className tcs+    supDicts <- join <$> zipWithM (\(Constraint supName supArgs _) index ->+                                      newDictionaries ((supName, index) : path)+                                                      name+                                                      (Constraint supName (instantiateSuperclass (map fst typeClassArguments) supArgs instanceTy) Nothing)+                                  ) typeClassSuperclasses [0..]+    return (TypeClassDictionaryInScope name path className instanceTy Nothing : supDicts)   where-  go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Maybe [(String, Type)]-  go [] REmpty            [] REmpty            = Just []-  go [] (TUnknown _)      _  _                 = Just []-  go [] (TypeVar v1)      [] (TypeVar v2)      | v1 == v2 = Just []-  go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) | s1 == s2 = Just []-  go sd r                 [] (TypeVar v)       = Just [(v, rowFromList (sd, r))]-  go _  _                 _  _                 = Nothing-typeHeadsAreEqual _ _ _ = Nothing+    instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]+    instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs --- |--- Check all values in a list pairwise match a predicate----pairwise :: (a -> a -> Bool) -> [a] -> Bool-pairwise _ [] = True-pairwise _ [_] = True-pairwise p (x : xs) = all (p x) xs && pairwise p xs+mkContext :: [TypeClassDictionaryInScope] -> InstanceContext+mkContext = foldr combineContexts M.empty . map fromDict where+  fromDict d = M.singleton Nothing (M.singleton (tcdClassName d) (M.singleton (tcdName d) d))++-- | Check all pairs of values in a list match a predicate+pairwiseAll :: (a -> a -> Bool) -> [a] -> Bool+pairwiseAll _ [] = True+pairwiseAll _ [_] = True+pairwiseAll p (x : xs) = all (p x) xs && pairwiseAll p xs++-- | Check any pair of values in a list match a predicate+pairwiseAny :: (a -> a -> Bool) -> [a] -> Bool+pairwiseAny _ [] = False+pairwiseAny _ [_] = False+pairwiseAny p (x : xs) = any (p x) xs || pairwiseAny p xs++pairwiseM :: Applicative m => (a -> a -> m ()) -> [a] -> m ()+pairwiseM _ [] = pure ()+pairwiseM _ [_] = pure ()+pairwiseM p (x : xs) = traverse (p x) xs *> pairwiseM p xs

@@ -16,7 +16,6 @@ import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State-import Control.Monad.Writer.Class (MonadWriter(..))  import qualified Data.Map as M @@ -96,19 +95,19 @@  -- | Infer the kind of a single type kindOf-  :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)+  :: (MonadError MultipleErrors m, MonadState CheckState m)   => Type   -> m Kind 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, MonadWriter MultipleErrors m) =>+  (MonadError MultipleErrors m, MonadState CheckState m) =>   Type ->   m (Kind, [(String, Kind)]) kindOfWithScopedVars ty =   withErrorMessageHint (ErrorCheckingKind ty) $-    fmap tidyUp . liftUnify $ infer ty+    fmap tidyUp . withFreshSubstitution . captureSubstitution $ infer ty   where   tidyUp ((k, args), sub) = ( starIfUnknown (substituteKind sub k)                             , map (second (starIfUnknown . substituteKind sub)) args@@ -116,14 +115,14 @@  -- | 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, MonadWriter MultipleErrors m)+  :: (MonadError MultipleErrors m, MonadState CheckState m)   => Bool   -> ModuleName   -> ProperName 'TypeName   -> [(String, Maybe Kind)]   -> [Type]   -> m Kind-kindsOf isData moduleName name args ts = fmap tidyUp . liftUnify $ do+kindsOf isData moduleName name args ts = fmap tidyUp . withFreshSubstitution . captureSubstitution $ do   tyCon <- freshKind   kargs <- replicateM (length args) freshKind   rest <- zipWithM freshKindVar args kargs@@ -145,12 +144,12 @@  -- | Simultaneously infer the kinds of several mutually recursive type constructors kindsOfAll-  :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)+  :: (MonadError MultipleErrors m, MonadState CheckState m)   => ModuleName   -> [(ProperName 'TypeName, [(String, Maybe Kind)], Type)]   -> [(ProperName 'TypeName, [(String, Maybe Kind)], [Type])]   -> m ([Kind], [Kind])-kindsOfAll moduleName syns tys = fmap tidyUp . liftUnify $ do+kindsOfAll moduleName syns tys = fmap tidyUp . withFreshSubstitution . captureSubstitution $ do   synVars <- replicateM (length syns) freshKind   let dict = zipWith (\(name, _, _) var -> (name, var)) syns synVars   bindLocalTypeVariables moduleName dict $ do

@@ -11,7 +11,7 @@ import Control.Arrow (second) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State-import Control.Monad.Writer.Class (MonadWriter(..), listen, censor)+import Control.Monad.Writer.Class (MonadWriter(..), censor)  import Data.Maybe import qualified Data.Map as M@@ -245,7 +245,7 @@ getLocalContext :: MonadState CheckState m => m Context getLocalContext = do   env <- getEnv-  return [ (ident, ty') | ((Qualified Nothing ident@Ident{}), (ty', _, Defined)) <- M.toList (names env) ]+  return [ (ident, ty') | (Qualified Nothing ident@Ident{}, (ty', _, Defined)) <- M.toList (names env) ]  -- | Update the @Environment@ putEnv :: (MonadState CheckState m) => Environment -> m ()@@ -269,23 +269,35 @@ guardWith e False = throwError e  -- | Run a computation in the substitution monad, generating a return value and the final substitution.-liftUnify ::-  (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>-  m a ->-  m (a, Substitution)-liftUnify = liftUnifyWarnings (const id)+captureSubstitution+  :: MonadState CheckState m+  => m a+  -> m (a, Substitution)+captureSubstitution = capturingSubstitution (,) --- | Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.-liftUnifyWarnings ::-  (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>-  (Substitution -> ErrorMessage -> ErrorMessage) ->-  m a ->-  m (a, Substitution)-liftUnifyWarnings replace ma = do+capturingSubstitution+  :: MonadState CheckState m+  => (a -> Substitution -> b)+  -> m a+  -> m b+capturingSubstitution f ma = do+  a <- ma+  subst <- gets checkSubstitution+  return (f a subst)++withFreshSubstitution+  :: MonadState CheckState m+  => m a+  -> m a+withFreshSubstitution ma = do   orig <- get   modify $ \st -> st { checkSubstitution = emptySubstitution }-  (a, w) <- reflectErrors . censor (const mempty) . reifyErrors . listen $ ma-  subst <- gets checkSubstitution-  tell . onErrorMessages (replace subst) $ w+  a <- ma   modify $ \st -> st { checkSubstitution = checkSubstitution orig }-  return (a, subst)+  return a++withoutWarnings+  :: MonadWriter w m+  => m a+  -> m (a, w)+withoutWarnings = censor (const mempty) . listen

@@ -61,7 +61,7 @@  -- | -- This function has one purpose - to skolemize type variables appearing in a--- SuperClassDictionary placeholder. These type variables are somewhat unique since they are the+-- DeferredDictionary placeholder. These type variables are somewhat unique since they are the -- only example of scoped type variables. -- skolemizeTypesInValue :: String -> Int -> SkolemScope -> Maybe SourceSpan -> Expr -> Expr@@ -71,8 +71,8 @@   in runIdentity . f   where   onExpr :: [String] -> Expr -> Identity ([String], Expr)-  onExpr sco (SuperClassDictionary c ts)-    | ident `notElem` sco = return (sco, SuperClassDictionary c (map (skolemize ident sko scope ss) ts))+  onExpr sco (DeferredDictionary c ts)+    | ident `notElem` sco = return (sco, DeferredDictionary c (map (skolemize ident sko scope ss) ts))   onExpr sco (TypedValue check val ty)     | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedValue check val (skolemize ident sko scope ss ty))   onExpr sco other = return (sco, other)

@@ -7,10 +7,13 @@  import Prelude.Compat +import Control.Monad (when) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), gets) -import Data.List (sortBy)+import Data.Foldable (for_)+import Data.List (sortBy, uncons)+import Data.List.Ordered (minusBy') import Data.Ord (comparing)  import Language.PureScript.AST@@ -26,7 +29,7 @@ subsumes :: (MonadError MultipleErrors m, MonadState CheckState m) => Maybe Expr -> Type -> Type -> m (Maybe Expr) subsumes val ty1 ty2 = withErrorMessageHint (ErrorInSubsumption ty1 ty2) $ subsumes' val ty1 ty2 --- | Check tahat one type subsumes another+-- | Check that one type subsumes another subsumes' :: (MonadError MultipleErrors m, MonadState CheckState m) =>   Maybe Expr ->   Type ->@@ -60,6 +63,14 @@     (ts2, r2') = rowToList r2     ts1' = sortBy (comparing fst) ts1     ts2' = sortBy (comparing fst) ts2+  -- For { ts1 | r1 } to subsume { ts2 | r2 } when r1 is empty (= we're working with a closed row),+  -- 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 (r1' == REmpty)+    (for_ (firstMissingProp ts2' ts1') (throwError . errorMessage . PropertyIsMissing . fst))+  when (r2' == REmpty)+    (for_ (firstMissingProp ts1' ts2') (throwError . errorMessage . AdditionalProperty . fst))   go ts1' ts2' r1' r2'   return val   where@@ -72,15 +83,13 @@                    -- What happens next is a bit of a hack.                    -- TODO: in the new type checker, object properties will probably be restricted to being monotypes                    -- in which case, this branch of the subsumes function should not even be necessary.-                   case r2' of-                     REmpty -> throwError . errorMessage $ AdditionalProperty p1-                     _ -> unifyTypes r2' (RCons p1 ty1 rest)+                   unifyTypes r2' (RCons p1 ty1 rest)                    go ts1 ((p2, ty2) : ts2) r1' rest     | otherwise = do rest <- freshType-                     case r1' of-                       REmpty -> throwError . errorMessage $ PropertyIsMissing p2-                       _ -> unifyTypes r1' (RCons p2 ty2 rest)+                     unifyTypes r1' (RCons p2 ty2 rest)                      go ((p1, ty1) : ts1) ts2 rest r2'+  -- Find the first property that's in the first list (of tuples) but not in the second+  firstMissingProp t1 t2 = fst <$> uncons (minusBy' (comparing fst) t1 t2) subsumes' val ty1 ty2@(TypeApp obj _) | obj == tyRecord = subsumes val ty2 ty1 subsumes' val ty1 ty2 = do   unifyTypes ty1 ty2

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}  -- | -- This module implements the type checker@@ -36,6 +37,7 @@ import Data.List (transpose, nub, (\\), partition, delete) import Data.Maybe (fromMaybe) import qualified Data.Map as M+import qualified Data.Set as S  import Language.PureScript.AST import Language.PureScript.Crash@@ -52,7 +54,6 @@ import Language.PureScript.TypeChecker.Subsumption import Language.PureScript.TypeChecker.Synonyms import Language.PureScript.TypeChecker.Unify-import Language.PureScript.TypeClassDictionaries import Language.PureScript.Types  data BindingGroupType@@ -62,66 +63,79 @@  -- | Infer the types of multiple mutually-recursive values, and return elaborated values including -- type class dictionaries and type annotations.-typesOf ::-  (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>-  BindingGroupType ->-  ModuleName ->-  [(Ident, Expr)] ->-  m [(Ident, (Expr, Type))]-typesOf bindingGroupType moduleName vals = do-  tys <- fmap tidyUp . escalateWarningWhen isHoleError . liftUnifyWarnings replace $ do-    (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup (Just moduleName) vals-    ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict-    ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict-    return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2)+typesOf+  :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => BindingGroupType+  -> ModuleName+  -> [(Ident, Expr)]+  -> m [(Ident, (Expr, Type))]+typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do+    (tys, w) <- withoutWarnings . capturingSubstitution tidyUp $ do+      (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup (Just moduleName) vals+      ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict+      ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict+      return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2) -  forM tys $ \(shouldGeneralize, (ident, (val, ty))) -> do-    -- Replace type class dictionary placeholders with actual dictionaries-    (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize moduleName val-    let unsolvedTypeVars = nub $ unknownsInType ty-    -- Generalize and constrain the type-    let generalized = generalize unsolved ty+    inferred <- forM tys $ \(shouldGeneralize, (ident, (val, ty))) -> do+      -- Replace type class dictionary placeholders with actual dictionaries+      (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize val+      -- Generalize and constrain the type+      currentSubst <- gets checkSubstitution+      let ty' = substituteType currentSubst ty+          unsolvedTypeVars = nub $ unknownsInType ty'+          generalized = generalize unsolved ty' -    when shouldGeneralize $ do-      -- Show the inferred type in a warning-      tell . errorMessage $ MissingTypeDeclaration ident generalized-      -- For non-recursive binding groups, can generalize over constraints.-      -- For recursive binding groups, we throw an error here for now.-      when (bindingGroupType == RecursiveBindingGroup && not (null unsolved))-        . throwError-        . errorMessage-        $ CannotGeneralizeRecursiveFunction ident generalized-      -- Make sure any unsolved type constraints only use type variables which appear-      -- unknown in the inferred type.-      forM_ unsolved $ \(_, con) -> do-        let constraintTypeVars = nub $ foldMap unknownsInType (constraintArgs con)-        when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $-          throwError . errorMessage $ NoInstanceFound con+      when shouldGeneralize $ do+        -- Show the inferred type in a warning+        tell . errorMessage $ MissingTypeDeclaration ident generalized+        -- For non-recursive binding groups, can generalize over constraints.+        -- For recursive binding groups, we throw an error here for now.+        when (bindingGroupType == RecursiveBindingGroup && not (null unsolved))+          . throwError+          . errorMessage+          $ CannotGeneralizeRecursiveFunction ident generalized+        -- Make sure any unsolved type constraints only use type variables which appear+        -- unknown in the inferred type.+        forM_ unsolved $ \(_, con) -> do+          -- We need information about functional dependencies, since we allow+          -- ambiguous types to be inferred if they can be solved by some functional+          -- dependency.+          let findClass = fromMaybe (internalError "entails: type class not found in environment") . M.lookup (constraintClass con)+          TypeClassData{ typeClassDependencies } <- gets (findClass . typeClasses . checkEnv)+          let solved = foldMap (S.fromList . fdDetermined) typeClassDependencies+          let constraintTypeVars = nub . foldMap (unknownsInType . fst) . filter ((`notElem` solved) . snd) $ zip (constraintArgs con) [0..]+          when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $+            throwError . onErrorMessages (replaceTypes currentSubst) . errorMessage $ NoInstanceFound con -    -- Check skolem variables did not escape their scope-    skolemEscapeCheck val'-    -- Check rows do not contain duplicate labels-    checkDuplicateLabels val'-    return (ident, (foldr (Abs . Left . fst) val' unsolved, generalized))-  where+      -- Check skolem variables did not escape their scope+      skolemEscapeCheck val'+      -- Check rows do not contain duplicate labels+      checkDuplicateLabels val'+      return (ident, (foldr (Abs . Left . fst) val' unsolved, generalized)) -  -- | Generalize type vars using forall and add inferred constraints-  generalize unsolved = varIfUnknown . constrain unsolved+    -- Show warnings here, since types in wildcards might have been solved during+    -- instance resolution (by functional dependencies).+    finalSubst <- gets checkSubstitution+    escalateWarningWhen isHoleError . tell . onErrorMessages (replaceTypes finalSubst) $ w -  -- | Add any unsolved constraints-  constrain [] = id-  constrain cs = ConstrainedType (map snd cs)+    return inferred+  where+    replaceTypes subst = onTypesInErrorMessage (substituteType subst) -  -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values-  tidyUp (ts, sub) = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts+    -- | Generalize type vars using forall and add inferred constraints+    generalize unsolved = varIfUnknown . constrain unsolved -  -- Replace all the wildcards types with their inferred types-  replace sub = onTypesInErrorMessage (substituteType sub)+    -- | Add any unsolved constraints+    constrain [] = id+    constrain cs = ConstrainedType (map snd cs) -  isHoleError :: ErrorMessage -> Bool-  isHoleError (ErrorMessage _ HoleInferredType{}) = True-  isHoleError _ = False+    -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values+    tidyUp ts sub = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts +    isHoleError :: ErrorMessage -> Bool+    isHoleError (ErrorMessage _ HoleInferredType{}) = True+    isHoleError _ = False+ type TypeData = M.Map (Qualified Ident) (Type, NameKind, NameVisibility)  type UntypedData = [(Ident, Type)]@@ -148,7 +162,7 @@     -- Make a map of names to the unification variables of untyped declarations     untypedDict = zip (map fst untyped) untypedNames     -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking-    dict = M.fromList (map (\(ident, ty) -> ((Qualified moduleName ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)+    dict = M.fromList (map (\(ident, ty) -> (Qualified moduleName ident, (ty, Private, Undefined))) $ typedDict ++ untypedDict)   return (untyped, typed, dict, untypedDict)  checkTypedBindingGroupElement@@ -278,7 +292,7 @@ infer' (Abs (Right _) _) = internalError "Binder was not desugared" infer' (App f arg) = do   f'@(TypedValue _ _ ft) <- infer f-  (ret, app) <- checkFunctionApplication f' ft arg Nothing+  (ret, app) <- checkFunctionApplication f' ft arg   return $ TypedValue True app ret infer' (Var var) = do   checkVisibility var@@ -311,7 +325,7 @@ infer' (Let ds val) = do   (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer   return $ TypedValue True (Let ds' val') valTy-infer' (SuperClassDictionary className tys) = do+infer' (DeferredDictionary className tys) = do   dicts <- getTypeClassDictionaries   hints <- gets checkHints   return $ TypeClassDictionary (Constraint className tys Nothing) dicts hints@@ -526,26 +540,6 @@   dicts <- join <$> zipWithM (newDictionaries []) (map (Qualified Nothing) dictNames) constraints   val' <- withBindingGroupVisible $ withTypeClassDictionaries dicts $ check val ty   return $ TypedValue True (foldr (Abs . Left) val' dictNames) t-  where-  -- | Add a dictionary for the constraint to the scope, and dictionaries-  -- for all implied superclass instances.-  newDictionaries-    :: [(Qualified (ProperName 'ClassName), Integer)]-    -> Qualified Ident-    -> Constraint-    -> m [TypeClassDictionaryInScope]-  newDictionaries path name (Constraint className instanceTy _) = do-    tcs <- gets (typeClasses . checkEnv)-    let (args, _, superclasses) = fromMaybe (internalError "newDictionaries: type class lookup failed") $ M.lookup className tcs-    supDicts <- join <$> zipWithM (\(Constraint supName supArgs _) index ->-                                      newDictionaries ((supName, index) : path)-                                                      name-                                                      (Constraint supName (instantiateSuperclass (map fst args) supArgs instanceTy) Nothing)-                                  ) superclasses [0..]-    return (TypeClassDictionaryInScope name path className instanceTy Nothing : supDicts)--  instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]-  instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs check' val u@(TUnknown _) = do   val'@(TypedValue _ _ ty) <- infer val   -- Don't unify an unknown with an inferred polytype@@ -573,8 +567,11 @@ check' (Abs (Right _) _) _ = internalError "Binder was not desugared" check' (App f arg) ret = do   f'@(TypedValue _ _ ft) <- infer f-  (_, app) <- checkFunctionApplication f' ft arg (Just ret)-  return $ TypedValue True app ret+  (retTy, app) <- checkFunctionApplication f' ft arg+  v' <- subsumes (Just app) retTy ret+  case v' of+    Nothing -> internalError "check: unable to check the subsumes relation."+    Just app' -> return $ TypedValue True app' ret check' v@(Var var) ty = do   checkVisibility var   repl <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable $ var@@ -583,7 +580,7 @@   case v' of     Nothing -> internalError "check: unable to check the subsumes relation."     Just v'' -> return $ TypedValue True v'' ty'-check' (SuperClassDictionary className tys) _ = do+check' (DeferredDictionary className tys) _ = do   {-   -- Here, we replace a placeholder for a superclass dictionary with a regular   -- TypeClassDictionary placeholder. The reason we do this is that it is necessary to have the@@ -698,55 +695,64 @@         return $ (p, v') : ps''   go _ _ _ = throwError . errorMessage $ ExprDoesNotHaveType expr (TypeApp tyRecord row) --- | Check the type of a function application, rethrowing errors to provide a better error message-checkFunctionApplication ::-  (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>-  Expr ->-  Type ->-  Expr ->-  Maybe Type ->-  m (Type, Expr)-checkFunctionApplication fn fnTy arg ret = withErrorMessageHint (ErrorInApplication fn fnTy arg) $ do+-- | Check the type of a function application, rethrowing errors to provide a better error message.+--+-- This judgment takes three inputs:+--+-- * The expression of the function we are applying+-- * The type of that function+-- * The expression we are applying it to+--+-- and synthesizes two outputs:+--+-- * The return type+-- * The elaborated expression for the function application (since we might need to+--   insert type class dictionaries, etc.)+checkFunctionApplication+  :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => Expr+  -- ^ The function expression+  -> Type+  -- ^ The type of the function+  -> Expr+  -- ^ The argument expression+  -> m (Type, Expr)+  -- ^ The result type, and the elaborated term+checkFunctionApplication fn fnTy arg = withErrorMessageHint (ErrorInApplication fn fnTy arg) $ do   subst <- gets checkSubstitution-  checkFunctionApplication' fn (substituteType subst fnTy) arg (substituteType subst <$> ret)+  checkFunctionApplication' fn (substituteType subst fnTy) arg  -- | Check the type of a function application-checkFunctionApplication' ::-  (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>-  Expr ->-  Type ->-  Expr ->-  Maybe Type ->-  m (Type, Expr)-checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do+checkFunctionApplication'+  :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+  => Expr+  -> Type+  -> Expr+  -> m (Type, Expr)+checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg = do   unifyTypes tyFunction' tyFunction   arg' <- check arg argTy-  case ret of-    Nothing -> return (retTy, App fn arg')-    Just ret' -> do-      Just app' <- subsumes (Just (App fn arg')) retTy ret'-      return (retTy, app')-checkFunctionApplication' fn (ForAll ident ty _) arg ret = do+  return (retTy, App fn arg')+checkFunctionApplication' fn (ForAll ident ty _) arg = do   replaced <- replaceVarWithUnknown ident ty-  checkFunctionApplication fn replaced arg ret-checkFunctionApplication' fn u@(TUnknown _) arg ret = do+  checkFunctionApplication fn replaced arg+checkFunctionApplication' fn (KindedType ty _) arg =+  checkFunctionApplication fn ty arg+checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg = do+  dicts <- getTypeClassDictionaries+  hints <- gets checkHints+  checkFunctionApplication' (foldl App fn (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) fnTy arg+checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} =+  return (fnTy, App fn dict)+checkFunctionApplication' fn u arg = do   arg' <- do     TypedValue _ arg' t <- infer arg     (arg'', t') <- instantiatePolyTypeWithUnknowns arg' t     return $ TypedValue True arg'' t'   let ty = (\(TypedValue _ _ t) -> t) arg'-  ret' <- maybe freshType return ret-  unifyTypes u (function ty ret')-  return (ret', App fn arg')-checkFunctionApplication' fn (KindedType ty _) arg ret =-  checkFunctionApplication fn ty arg ret-checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do-  dicts <- getTypeClassDictionaries-  hints <- gets checkHints-  checkFunctionApplication' (foldl App fn (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) fnTy arg ret-checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} _ =-  return (fnTy, App fn dict)-checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg+  ret <- freshType+  unifyTypes u (function ty ret)+  return (ret, App fn arg')  -- | -- Ensure a set of property names and value does not contain duplicate labels

@@ -10,7 +10,6 @@   , unknownsInType   , unifyTypes   , unifyRows-  , unifiesWith   , replaceVarWithUnknown   , replaceTypeWildcards   , varIfUnknown@@ -102,6 +101,7 @@   unifyTypes' (TypeVar v1) (TypeVar v2) | v1 == v2 = return ()   unifyTypes' ty1@(TypeConstructor c1) ty2@(TypeConstructor c2) =     guardWith (errorMessage (TypesDoNotUnify ty1 ty2)) (c1 == c2)+  unifyTypes' (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = return ()   unifyTypes' (TypeApp t3 t4) (TypeApp t5 t6) = do     t3 `unifyTypes` t5     t4 `unifyTypes` t6@@ -151,36 +151,6 @@   unifyRows' [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) | s1 == s2 = return ()   unifyRows' _ _ _ _ =     throwError . errorMessage $ TypesDoNotUnify r1 r2---- |--- Check that two types unify----unifiesWith :: Type -> Type -> Bool-unifiesWith (TUnknown u1)        (TUnknown u2)        = u1 == u2-unifiesWith (Skolem _ s1 _ _)    (Skolem _ s2 _ _)    = s1 == s2-unifiesWith (TypeVar v1)         (TypeVar v2)         = v1 == v2-unifiesWith (TypeLevelString s1) (TypeLevelString s2) = s1 == s2-unifiesWith (TypeConstructor c1) (TypeConstructor c2) = c1 == c2-unifiesWith (TypeApp h1 t1)      (TypeApp h2 t2)      = h1 `unifiesWith` h2 && t1 `unifiesWith` t2-unifiesWith REmpty               REmpty               = True-unifiesWith r1@RCons{}           r2@RCons{} =-  let (s1, r1') = rowToList r1-      (s2, r2') = rowToList r2--      int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]-      sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]-      sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]-  in all (uncurry unifiesWith) int && go sd1 r1' sd2 r2'-  where-  go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool-  go [] REmpty          [] REmpty          = True-  go [] (TypeVar v1)    [] (TypeVar v2)    = v1 == v2-  go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2-  go [] (TUnknown _)    _  _               = True-  go _  _               [] (TUnknown _)    = True-  go _  (TUnknown _)    _  (TUnknown _)    = True-  go _  _               _  _               = False-unifiesWith _ _ = False  -- | -- Replace a single type variable with a new unification variable

@@ -22,26 +22,3 @@     , tcdDependencies :: Maybe [Constraint]     }     deriving (Show)---- |--- A simplified representation of expressions which are used to represent type--- class dictionaries at runtime, which can be compared for equality----data DictionaryValue-  -- |-  -- A dictionary which is brought into scope by a local constraint-  ---  = LocalDictionaryValue (Qualified Ident)-  -- |-  -- A dictionary which is brought into scope by an instance declaration-  ---  | GlobalDictionaryValue (Qualified Ident)-  -- |-  -- A dictionary which depends on other dictionaries-  ---  | DependentDictionaryValue (Qualified Ident) [DictionaryValue]-  -- |-  -- A subclass dictionary-  ---  | SubclassDictionaryValue DictionaryValue (Qualified (ProperName 'ClassName)) Integer-  deriving (Show, Ord, Eq)

@@ -257,8 +257,8 @@   go (PrettyPrintFunction t1 t2) = PrettyPrintFunction (go (f t1)) (go (f t2))   go (PrettyPrintObject t) = PrettyPrintObject (go (f t))   go (PrettyPrintForAll args t) = PrettyPrintForAll args (go (f t))-  go (BinaryNoParensType t1 t2 t3) = BinaryNoParensType (f (go t1)) (f (go t2)) (f (go t3))-  go (ParensInType t) = ParensInType (f (go t))+  go (BinaryNoParensType t1 t2 t3) = BinaryNoParensType (go (f t1)) (go (f t2)) (go (f t3))+  go (ParensInType t) = ParensInType (go (f t))   go other = f other  everywhereOnTypesM :: Monad m => (Type -> m Type) -> Type -> m Type

@@ -1,5 +1,12 @@-resolver: lts-6.9+resolver: lts-6.13 packages: - '.'-extra-deps: []-flags: {}+extra-deps:+- aeson-1.0.0.0+- http-client-0.5.1+- http-client-tls-0.3.0+- pipes-http-1.0.4+- semigroups-0.18.2+flags:+  semigroups:+    bytestring-builder: false

@@ -70,7 +70,7 @@         addValueImport i mn is =           prettyPrintImportSection (addExplicitImport' (IdeValue (P.Ident i) wildcard) mn is)         addOpImport op mn is =-          prettyPrintImportSection (addExplicitImport' (IdeValueOperator op "" 2 P.Infix) mn is)+          prettyPrintImportSection (addExplicitImport' (IdeValueOperator op (P.Qualified Nothing (Left (P.Ident ""))) 2 P.Infix Nothing) mn is)         addDtorImport i t mn is =           prettyPrintImportSection (addExplicitImport' (IdeDataConstructor (P.ProperName i) t wildcard) mn is)     it "adds an implicit unqualified import" $

@@ -37,13 +37,11 @@        , getFlexCompletions        , getFlexCompletionsInModule        , getType-       , getInfo        , rebuildModule        , reset          -- checking results        , resultIsSuccess        , parseCompletions-       , parseInfo        , parseTextResult        ) where @@ -95,7 +93,7 @@   pdir <- projectDirectory   (_, _, _, procHandle) <- createProcess $     (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }-  r <- tryNTimes 5 (getProcessExitCode procHandle)+  r <- tryNTimes 10 (getProcessExitCode procHandle)   pure (fromMaybe False (isSuccess <$> r))  tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)@@ -158,18 +156,15 @@ loadAll :: IO Text loadAll = sendCommand (load []) -getFlexCompletions :: Text -> IO [(Text, Text, Text)]+getFlexCompletions :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)] getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing) -getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text)]+getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)] getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) (Just m)) -getType :: Text -> IO [(Text, Text, Text)]+getType :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)] getType q = parseCompletions <$> sendCommand (typeC q []) -getInfo :: Text -> IO [P.SourceSpan]-getInfo q = parseInfo <$> sendCommand (typeC q [])- addImport :: Text -> FilePath -> FilePath -> IO Text addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp) @@ -254,17 +249,14 @@     Left err -> pure (Left err)     Right res -> Right <$> p res -completionParser :: Value -> Parser [(Text, Text, Text)]+completionParser :: Value -> Parser [(Text, Text, Text, Maybe P.SourceSpan)] completionParser = withArray "res" $ \cs ->   mapM (withObject "completion" $ \o -> do            ident <- o .: "identifier"            module' <- o .: "module"            ty <- o .: "type"-           pure (module', ident, ty)) (V.toList cs)--infoParser :: Value -> Parser [P.SourceSpan]-infoParser = withArray "res" $ \cs ->-  mapM (withObject "info" $ \o -> o .: "definedAt") (V.toList cs)+           ss <- o .: "definedAt"+           pure (module', ident, ty, ss)) (V.toList cs)  valueFromText :: Text -> Value valueFromText = fromJust . decode . toS@@ -272,13 +264,9 @@ resultIsSuccess :: Text -> Bool resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText -parseCompletions :: Text -> [(Text, Text, Text)]+parseCompletions :: Text -> [(Text, Text, Text, Maybe P.SourceSpan)] parseCompletions s =   fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))--parseInfo :: Text -> [P.SourceSpan]-parseInfo s =-  fromJust $ join (rightToMaybe <$> parseMaybe (withResult infoParser) (valueFromText s))  parseTextResult :: Text -> Text parseTextResult s =

@@ -9,20 +9,21 @@ import           Language.PureScript.Ide.Integration import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Util import           Test.Hspec -value :: Text -> IdeDeclaration-value s = IdeValue (P.Ident (toS s)) P.REmpty+value :: Text -> IdeDeclarationAnn+value s = withEmptyAnn (IdeValue (P.Ident (toS s)) P.REmpty) -firstResult, secondResult, fiult :: Match IdeDeclaration+firstResult, secondResult, fiult :: Match IdeDeclarationAnn firstResult = Match (P.moduleNameFromString "Match", value "firstResult") secondResult = Match (P.moduleNameFromString "Match", value "secondResult") fiult = Match (P.moduleNameFromString "Match", value "fiult") -completions :: [Match IdeDeclaration]+completions :: [Match IdeDeclarationAnn] completions = [firstResult, secondResult, fiult] -runFlex :: Text -> [Match IdeDeclaration]+runFlex :: Text -> [Match IdeDeclarationAnn] runFlex s = runMatcher (flexMatcher s) completions  setup :: IO ()@@ -43,5 +44,6 @@         cs <- getFlexCompletions ""         cs `shouldBe` []       it "matches on equality" $ do-        cs <- getFlexCompletions "const"-        cs `shouldBe` [("MatcherSpec", "const", "forall a b. a -> b -> a")]+        -- ignore any position information+        (m, i, t, _) : _ <- getFlexCompletions "const"+        (m, i, t) `shouldBe` ("MatcherSpec", "const", "forall a b. a -> b -> a")

@@ -2,7 +2,7 @@ {-# LANGUAGE NoImplicitPrelude #-} module Language.PureScript.Ide.ReexportsSpec where -import qualified Prelude as Prelude+import qualified Prelude import           Protolude  import qualified Data.Map as Map

@@ -14,23 +14,28 @@ setup = void (Integration.reset *> Integration.loadAll)  spec :: Spec-spec = beforeAll_ setup $ do+spec = beforeAll_ setup $   describe "Sourcefile Integration" $ do-    it "finds a value declaration" $ do+    it "finds a value declaration" $       testCase "sfValue" (3, 1)-    it "finds a type declaration" $ do+    it "finds a type declaration" $       testCase "SFType" (5, 1)-    it "finds a data declaration" $ do+    it "finds a data declaration" $       testCase "SFData" (7, 1)-    it "finds a data constructor" $ do+    it "finds a data constructor" $       testCase "SFOne" (7, 1)-    it "finds a typeclass" $ do+    it "finds a typeclass" $       testCase "SFClass" (9, 1)-    it "finds a typeclass member" $ do+    it "finds a typeclass member" $       testCase "sfShow" (10, 3)  testCase :: Text -> (Int, Int) -> IO () testCase s (x, y) = do-  (P.SourceSpan f (P.SourcePos l c) _):_ <- Integration.getInfo s+  P.SourceSpan f (P.SourcePos l c) _ <- getLocation s   toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"   (l, c) `shouldBe` (x, y)++getLocation :: Text -> IO P.SourceSpan+getLocation s = do+  (_, _, _, Just location) : _ <- Integration.getType s+  pure location

@@ -13,11 +13,12 @@ span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2) span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3) -value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration+typeAnnotation1, value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration+typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left []) synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty-class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] []-class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] []+class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] [] []+class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] [] []   [P.PositionedDeclaration span2 [] member1] data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] [] data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]@@ -44,3 +45,6 @@       extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]     it "extracts a span for a data foreign declaration" $       extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]+  describe "Type annotations" $ do+    it "extracts a type annotation" $+      extractTypeAnnotations [typeAnnotation1] `shouldBe` [(P.Ident "value1", P.REmpty)]

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Language.PureScript.Ide.StateSpec where++import           Protolude+import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.State+import qualified Language.PureScript as P+import           Test.Hspec+import qualified Data.Map as Map++valueOperator :: Maybe P.Type -> IdeDeclarationAnn+valueOperator =+  d . IdeValueOperator (P.OpName "<$>") (P.Qualified (Just (mn "Test")) (Left (P.Ident "function"))) 2 P.Infix++ctorOperator :: Maybe P.Type -> IdeDeclarationAnn+ctorOperator =+  d . IdeValueOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (Right (P.ProperName "Cons"))) 2 P.Infix++typeOperator :: Maybe P.Kind -> IdeDeclarationAnn+typeOperator =+  d . IdeTypeOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (P.ProperName "List")) 2 P.Infix++testModule :: Module+testModule = (mn "Test", [ d (IdeValue (P.Ident "function") P.REmpty)+                         , d (IdeDataConstructor (P.ProperName "Cons") (P.ProperName "List") (P.REmpty))+                         , d (IdeType (P.ProperName "List") P.Star)+                         , valueOperator Nothing+                         , ctorOperator Nothing+                         , typeOperator Nothing+                         ])++d :: IdeDeclaration -> IdeDeclarationAnn+d = IdeDeclarationAnn emptyAnn++mn :: Text -> P.ModuleName+mn = P.moduleNameFromString . toS++testState :: Map P.ModuleName [IdeDeclarationAnn]+testState = Map.fromList+  [ testModule+  ]++spec :: Spec+spec = describe "resolving operators" $ do+  it "resolves the type for a value operator" $+    resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.REmpty))+  it "resolves the type for a constructor operator" $+    resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.REmpty))+  it "resolves the kind for a type operator" $+    resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.Star))

@@ -278,6 +278,7 @@       [ ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "explicit" (ShowFn (hasTypeVar "something"))       , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt"    (ShowFn (P.tyInt ==))       , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber"  (ShowFn (P.tyNumber ==))+      , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "nestedForAll" (renderedType "forall c. (forall a b. c)")       ])    , ("ConstrainedArgument",

@@ -11,4 +11,5 @@   s <- compileTestProject   unless s $ fail "Failed to compile .purs sources" +  quitServer -- shuts down any left over server (primarily happens during development)   withServer (hspec PscIdeSpec.spec)

@@ -102,7 +102,6 @@   , ("ST.new", ["ST.newSTRef"])   , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])   ]-  where  assertCompletedOk :: (String, [String]) -> Assertion assertCompletedOk (line, expecteds) = do

@@ -75,6 +75,8 @@   , "Data.Function"   , "Data.Functor"   , "Data.HeytingAlgebra"+  , "Data.NaturalTransformation"+  , "Data.Newtype"   , "Data.Ord.Unsafe"   , "Data.Ord"   , "Data.Ordering"

@@ -5,8 +5,9 @@     "purescript-console": "1.0.0-rc.1",     "purescript-eff": "1.0.0-rc.1",     "purescript-functions": "1.0.0-rc.1",-    "purescript-prelude": "1.0.0-rc.3",+    "purescript-prelude": "1.1.0",     "purescript-st": "1.0.0-rc.1",-    "purescript-partial": "1.1.2"+    "purescript-partial": "1.1.2",+    "purescript-newtype": "0.1.0"   } }