purescript 0.15.6 → 0.15.7

raw patch · 102 files changed

+2115/−2059 lines, 102 filesdep +template-haskelldep −aeson-prettydep −fsnotifydep −http-typesdep ~file-embedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: template-haskell

Dependencies removed: aeson-pretty, fsnotify, http-types, syb, transformers-compat, unordered-containers

Dependency ranges changed: file-embed

API changes (from Hackage documentation)

Files

• CONTRIBUTORS.md +2/−0
• INSTALL.md +2/−2
• LICENSE +0/−206
• purescript.cabal +50/−47
• src/Language/PureScript/AST/Declarations.hs +1/−1
• src/Language/PureScript/CST/Layout.hs +1/−1
• src/Language/PureScript/CST/Lexer.hs +2/−2
• src/Language/PureScript/CodeGen/JS.hs +3/−3
• src/Language/PureScript/Constants/Data/Foldable.hs +0/−28
• src/Language/PureScript/Constants/Data/Generic/Rep.hs +0/−39
• src/Language/PureScript/Constants/Data/Newtype.hs +0/−6
• src/Language/PureScript/Constants/Data/Traversable.hs +0/−19
• src/Language/PureScript/Constants/Libs.hs +264/−0
• src/Language/PureScript/Constants/Prelude.hs +0/−455
• src/Language/PureScript/Constants/Prim.hs +42/−180
• src/Language/PureScript/Constants/TH.hs +224/−0
• src/Language/PureScript/CoreFn/CSE.hs +1/−1
• src/Language/PureScript/CoreFn/Desugar.hs +1/−1
• src/Language/PureScript/CoreFn/Laziness.hs +3/−4
• src/Language/PureScript/CoreFn/Optimizer.hs +4/−5
• src/Language/PureScript/CoreImp/Optimizer/Common.hs +9/−6
• src/Language/PureScript/CoreImp/Optimizer/Inliner.hs +103/−238
• src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs +19/−31
• src/Language/PureScript/CoreImp/Optimizer/Unused.hs +1/−1
• src/Language/PureScript/Docs/Convert/ReExports.hs +1/−2
• src/Language/PureScript/Docs/Prim.hs +63/−72
• src/Language/PureScript/Environment.hs +80/−98
• src/Language/PureScript/Errors.hs +32/−26
• src/Language/PureScript/Ide.hs +2/−1
• src/Language/PureScript/Ide/CaseSplit.hs +2/−2
• src/Language/PureScript/Ide/Completion.hs +1/−1
• src/Language/PureScript/Ide/Error.hs +1/−1
• src/Language/PureScript/Ide/Externs.hs +5/−5
• src/Language/PureScript/Ide/Filter.hs +31/−5
• src/Language/PureScript/Ide/Filter/Imports.hs +31/−0
• src/Language/PureScript/Ide/Imports.hs +4/−237
• src/Language/PureScript/Ide/Imports/Actions.hs +251/−0
• src/Language/PureScript/Ide/Matcher.hs +1/−1
• src/Language/PureScript/Ide/Prim.hs +8/−8
• src/Language/PureScript/Ide/Rebuild.hs +25/−4
• src/Language/PureScript/Ide/State.hs +1/−1
• src/Language/PureScript/Ide/Usage.hs +1/−1
• src/Language/PureScript/Interactive.hs +4/−4
• src/Language/PureScript/Linter.hs +2/−2
• src/Language/PureScript/Linter/Exhaustive.hs +2/−3
• src/Language/PureScript/Linter/Imports.hs +1/−1
• src/Language/PureScript/Make.hs +4/−4
• src/Language/PureScript/Make/Actions.hs +35/−20
• src/Language/PureScript/Make/BuildPlan.hs +1/−1
• src/Language/PureScript/Pretty/Common.hs +2/−2
• src/Language/PureScript/Sugar/AdoNotation.hs +4/−4
• src/Language/PureScript/Sugar/DoNotation.hs +5/−5
• src/Language/PureScript/Sugar/Names.hs +14/−7
• src/Language/PureScript/Sugar/Names/Common.hs +1/−1
• src/Language/PureScript/Sugar/Names/Env.hs +9/−9
• src/Language/PureScript/Sugar/Operators.hs +4/−4
• src/Language/PureScript/Sugar/TypeClasses.hs +7/−7
• src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +21/−22
• src/Language/PureScript/TypeChecker.hs +3/−4
• src/Language/PureScript/TypeChecker/Deriving.hs +302/−90
• src/Language/PureScript/TypeChecker/Entailment.hs +20/−19
• src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +8/−11
• src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs +7/−7
• src/Language/PureScript/TypeChecker/Kinds.hs +1/−1
• src/Language/PureScript/Types.hs +1/−1
• stack.yaml +1/−1
• tests/Language/PureScript/Ide/FilterSpec.hs +62/−1
• tests/Language/PureScript/Ide/ImportsSpec.hs +1/−0
• tests/TestMake.hs +2/−2
• tests/purs/failing/2567.out +1/−1
• tests/purs/failing/BifunctorInstance1.out +16/−0
• tests/purs/failing/BifunctorInstance1.purs +10/−0
• tests/purs/failing/ContravariantInstance1.out +16/−0
• tests/purs/failing/ContravariantInstance1.purs +9/−0
• tests/purs/failing/DuplicateDeclarationsInLet.out +2/−2
• tests/purs/failing/DuplicateDeclarationsInLet.purs +0/−2
• tests/purs/failing/DuplicateDeclarationsInLet2.out +10/−0
• tests/purs/failing/DuplicateDeclarationsInLet2.purs +10/−0
• tests/purs/failing/DuplicateDeclarationsInLet3.out +22/−0
• tests/purs/failing/DuplicateDeclarationsInLet3.purs +16/−0
• tests/purs/failing/FoldableInstance10.out +1/−1
• tests/purs/failing/FoldableInstance4.out +7/−14
• tests/purs/failing/FoldableInstance4.purs +1/−1
• tests/purs/failing/FoldableInstance5.out +0/−16
• tests/purs/failing/FoldableInstance5.purs +0/−9
• tests/purs/failing/FoldableInstance6.out +1/−1
• tests/purs/failing/FoldableInstance7.out +0/−16
• tests/purs/failing/FoldableInstance7.purs +0/−9
• tests/purs/failing/FoldableInstance8.out +2/−2
• tests/purs/failing/FoldableInstance9.out +10/−8
• tests/purs/failing/FunctorInstance1.out +16/−0
• tests/purs/failing/FunctorInstance1.purs +8/−0
• tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.out +1/−1
• tests/purs/failing/ProgrammableTypeErrors.out +1/−1
• tests/purs/failing/ProgrammableTypeErrorsTypeString.out +1/−1
• tests/purs/passing/DerivingBifunctor.purs +26/−0
• tests/purs/passing/DerivingContravariant.purs +20/−0
• tests/purs/passing/DerivingFunctorFromBi.purs +18/−0
• tests/purs/passing/DerivingFunctorFromContra.purs +13/−0
• tests/purs/passing/DerivingFunctorFromPro.purs +16/−0
• tests/purs/passing/DerivingFunctorPrefersSimplerClasses.purs +46/−0
• tests/purs/passing/DerivingProfunctor.purs +19/−0

@@ -160,6 +160,8 @@ | [@sd-yip](https://github.com/sd-yip) | Nicholas Yip | [MIT license](http://opensource.org/licenses/MIT) | | [@j-nava](https://github.com/j-nava) | Jesse Nava | [MIT license](http://opensource.org/licenses/MIT) | | [@imcotton](https://github.com/imcotton) | Cotton Hou | [MIT license](http://opensource.org/licenses/MIT) |+| [@wclr](https://github.com/wclr) | Alex Osh | [MIT license](http://opensource.org/licenses/MIT) |+| [@Deltaspace0](https://github.com/Deltaspace0) | Ruslan Gadeev | [MIT license](http://opensource.org/licenses/MIT) |  ### Contributors using Modified Terms 

@@ -4,12 +4,12 @@  ## Requirements -The PureScript compiler is built using GHC 9.2.3, and should be able to run on any operating system supported by GHC 9.2.3. In particular:+The PureScript compiler is built using GHC 9.2.4, and should be able to run on any operating system supported by GHC 9.2.4. In particular:  * for Windows users, versions predating Vista are not officially supported, * for macOS / OS X users, versions predating Mac OS X 10.7 (Lion) are not officially supported. -See also <https://www.haskell.org/ghc/download_ghc_9_2_3.html> for more details about the operating systems which GHC 9.2.3 supports.+See also <https://www.haskell.org/ghc/download_ghc_9_2_4.html> for more details about the operating systems which GHC 9.2.4 supports.  ## Official prebuilt binaries 

@@ -22,7 +22,6 @@   adjunctions   aeson   aeson-better-errors-  aeson-pretty   alex   ansi-terminal   ansi-wl-pprint@@ -45,9 +44,7 @@   boxes   bytestring   call-stack-  case-insensitive   cborg-  cereal   cheapskate   clock   colour@@ -77,15 +74,12 @@   file-embed   filepath   free-  fsnotify   ghc-bignum   ghc-prim   half   happy   hashable   haskeline-  hfsevents-  http-types   indexed-traversable   indexed-traversable-instances   integer-gmp@@ -422,39 +416,6 @@   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.- alex LICENSE file:    Copyright (c) 1995-2011, Chris Dornan and Simon Marlow@@ -1204,40 +1165,6 @@   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN   THE SOFTWARE. -case-insensitive LICENSE file:--  Copyright (c) 2011-2013 Bas van Dijk--  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.--      * The name of Bas van Dijk and the names of contributors may NOT-        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.- cborg LICENSE file:    Copyright (c) 2015-2017 Duncan Coutts,@@ -1274,39 +1201,6 @@   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -cereal LICENSE file:--  Copyright (c) Lennart Kolmodin, Galois, Inc.--  All rights reserved.--  Redistribution and use in source and binary forms, with or without-  modification, are permitted provided that the following conditions-  are met:--  1. Redistributions of source code must retain the above copyright-     notice, this list of conditions and the following disclaimer.--  2. Redistributions in binary form must reproduce the above copyright-     notice, this list of conditions and the following disclaimer in the-     documentation and/or other materials provided with the distribution.--  3. Neither the name of the author nor the names of his contributors-     may be used to endorse or promote products derived from this software-     without specific prior written permission.--  THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS-  OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-  DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-  POSSIBILITY OF SUCH DAMAGE.- cheapskate LICENSE file:    Copyright (c) 2013, John MacFarlane@@ -2200,39 +2094,6 @@   ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE   POSSIBILITY OF SUCH DAMAGE. -fsnotify LICENSE file:--  Copyright (c) 2012, Mark Dittmer--  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 Mark Dittmer 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.- ghc-bignum LICENSE file:    The Glasgow Haskell Compiler License@@ -2454,73 +2315,6 @@   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.--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:--      * 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 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 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-  Copyright (c) 2011, 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.--      * Neither the name of Aristid Breitkreuz 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.  indexed-traversable LICENSE file:

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               purescript-version:            0.15.6+version:            0.15.7 license:            BSD-3-Clause license-file:       LICENSE copyright:@@ -76,11 +76,7 @@         Language.PureScript.CodeGen.JS         Language.PureScript.CodeGen.JS.Common         Language.PureScript.CodeGen.JS.Printer-        Language.PureScript.Constants.Prelude-        Language.PureScript.Constants.Data.Foldable-        Language.PureScript.Constants.Data.Generic.Rep-        Language.PureScript.Constants.Data.Newtype-        Language.PureScript.Constants.Data.Traversable+        Language.PureScript.Constants.Libs         Language.PureScript.CoreFn         Language.PureScript.CoreFn.Ann         Language.PureScript.CoreFn.Binders@@ -151,7 +147,9 @@         Language.PureScript.Ide.Externs         Language.PureScript.Ide.Filter         Language.PureScript.Ide.Filter.Declaration+        Language.PureScript.Ide.Filter.Imports         Language.PureScript.Ide.Imports+        Language.PureScript.Ide.Imports.Actions         Language.PureScript.Ide.Logging         Language.PureScript.Ide.Matcher         Language.PureScript.Ide.Prim@@ -239,6 +237,7 @@     hs-source-dirs:     src     other-modules:         Data.Text.PureScript+        Language.PureScript.Constants.TH         Paths_purescript      autogen-modules:    Paths_purescript@@ -254,12 +253,18 @@         TupleSections TypeFamilies ViewPatterns      ghc-options:-        -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missed-specialisations+        -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe+        -Wno-trustworthy-safe -Wno-inferred-safe-imports+        -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-missing-deriving-strategies+        -Wno-missing-export-lists -Wno-missing-kind-signatures+        -Wno-partial-fields -Wno-prepositive-qualified-module      build-depends:         aeson >=2.0.3.0 && <2.1,         aeson-better-errors >=0.9.1.1 && <0.10,-        aeson-pretty >=0.8.9 && <0.9,         ansi-terminal >=0.11.3 && <0.12,         array >=0.5.4.0 && <0.6,         base >=4.16.2.0 && <4.17,@@ -273,15 +278,14 @@         cheapskate >=0.1.1.2 && <0.2,         clock >=0.8.3 && <0.9,         containers >=0.6.5.1 && <0.7,-        cryptonite ==0.30.*,+        cryptonite >=0.30 && <0.31,         data-ordlist >=0.4.7.0 && <0.5,         deepseq >=1.4.6.1 && <1.5,         directory >=1.3.6.2 && <1.4,-        dlist ==1.0.*,+        dlist >=1.0 && <1.1,         edit-distance >=0.2.2.1 && <0.3,         file-embed >=0.0.15.0 && <0.1,         filepath >=1.4.2.2 && <1.5,-        fsnotify >=0.3.0.1 && <0.4,         Glob >=0.10.2 && <0.11,         haskeline >=0.8.2 && <0.9,         language-javascript ==0.7.0.0,@@ -301,21 +305,17 @@         regex-tdfa >=1.3.1.2 && <1.4,         safe >=0.3.19 && <0.4,         scientific >=0.3.7.0 && <0.4,-        semigroups ==0.20.*,+        semigroups >=0.20 && <0.21,         semialign >=1.2.0.1 && <1.3,         sourcemap >=0.1.7 && <0.2,-        split >=0.2.3.4 && <0.3,         stm >=2.5.0.2 && <2.6,         stringsearch >=0.3.6.6 && <0.4,-        syb >=0.7.2.1 && <0.8,+        template-haskell >=2.18.0.0 && <2.19,         text >=1.2.5.0 && <1.3,         these >=1.1.1.1 && <1.2,         time >=1.11.1.1 && <1.12,         transformers >=0.5.6.2 && <0.6,         transformers-base >=0.4.6 && <0.5,-        transformers-compat >=0.7.1 && <0.8,-        typed-process >=0.2.10.1 && <0.3,-        unordered-containers >=0.2.19.1 && <0.3,         utf8-string >=1.0.2 && <1.1,         vector >=0.12.3.1 && <0.13,         witherable >=0.4.2 && <0.5@@ -351,13 +351,20 @@         TupleSections TypeFamilies ViewPatterns      ghc-options:-        -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missed-specialisations+        -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe+        -Wno-trustworthy-safe -Wno-inferred-safe-imports+        -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-missing-deriving-strategies+        -Wno-missing-export-lists -Wno-missing-kind-signatures+        -Wno-partial-fields -Wno-prepositive-qualified-module         -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N+        -Wno-unused-packages      build-depends:         aeson >=2.0.3.0 && <2.1,         aeson-better-errors >=0.9.1.1 && <0.10,-        aeson-pretty >=0.8.9 && <0.9,         ansi-terminal >=0.11.3 && <0.12,         array >=0.5.4.0 && <0.6,         base >=4.16.2.0 && <4.17,@@ -371,15 +378,14 @@         cheapskate >=0.1.1.2 && <0.2,         clock >=0.8.3 && <0.9,         containers >=0.6.5.1 && <0.7,-        cryptonite ==0.30.*,+        cryptonite >=0.30 && <0.31,         data-ordlist >=0.4.7.0 && <0.5,         deepseq >=1.4.6.1 && <1.5,         directory >=1.3.6.2 && <1.4,-        dlist ==1.0.*,+        dlist >=1.0 && <1.1,         edit-distance >=0.2.2.1 && <0.3,         file-embed >=0.0.15.0 && <0.1,         filepath >=1.4.2.2 && <1.5,-        fsnotify >=0.3.0.1 && <0.4,         Glob >=0.10.2 && <0.11,         haskeline >=0.8.2 && <0.9,         language-javascript ==0.7.0.0,@@ -399,31 +405,25 @@         regex-tdfa >=1.3.1.2 && <1.4,         safe >=0.3.19 && <0.4,         scientific >=0.3.7.0 && <0.4,-        semigroups ==0.20.*,+        semigroups >=0.20 && <0.21,         semialign >=1.2.0.1 && <1.3,         sourcemap >=0.1.7 && <0.2,-        split >=0.2.3.4 && <0.3,         stm >=2.5.0.2 && <2.6,         stringsearch >=0.3.6.6 && <0.4,-        syb >=0.7.2.1 && <0.8,+        template-haskell >=2.18.0.0 && <2.19,         text >=1.2.5.0 && <1.3,         these >=1.1.1.1 && <1.2,         time >=1.11.1.1 && <1.12,         transformers >=0.5.6.2 && <0.6,         transformers-base >=0.4.6 && <0.5,-        transformers-compat >=0.7.1 && <0.8,-        typed-process >=0.2.10.1 && <0.3,-        unordered-containers >=0.2.19.1 && <0.3,         utf8-string >=1.0.2 && <1.1,         vector >=0.12.3.1 && <0.13,         witherable >=0.4.2 && <0.5,         ansi-wl-pprint >=0.6.9 && <0.7,         exceptions >=0.10.4 && <0.11,-        file-embed >=0.0.13.0 && <0.1,-        http-types >=0.12.3 && <0.13,         network >=3.1.2.7 && <3.2,         optparse-applicative >=0.17.0.0 && <0.18,-        purescript -any+        purescript      if flag(release)         cpp-options: -DRELEASE@@ -435,8 +435,8 @@     type:               exitcode-stdio-1.0     main-is:            Main.hs     build-tool-depends:-        happy:happy ==1.20.0, hspec-discover:hspec-discover -any,-        purescript:purs -any+        happy:happy ==1.20.0, hspec-discover:hspec-discover,+        purescript:purs      hs-source-dirs:     tests     other-modules:@@ -483,13 +483,19 @@         TupleSections TypeFamilies ViewPatterns      ghc-options:-        -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates-        -Wno-incomplete-uni-patterns+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missed-specialisations+        -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe+        -Wno-trustworthy-safe -Wno-inferred-safe-imports+        -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-missing-deriving-strategies+        -Wno-missing-export-lists -Wno-missing-kind-signatures+        -Wno-partial-fields -Wno-prepositive-qualified-module+        -Wno-incomplete-uni-patterns -Wno-unused-packages      build-depends:         aeson >=2.0.3.0 && <2.1,         aeson-better-errors >=0.9.1.1 && <0.10,-        aeson-pretty >=0.8.9 && <0.9,         ansi-terminal >=0.11.3 && <0.12,         array >=0.5.4.0 && <0.6,         base >=4.16.2.0 && <4.17,@@ -503,15 +509,14 @@         cheapskate >=0.1.1.2 && <0.2,         clock >=0.8.3 && <0.9,         containers >=0.6.5.1 && <0.7,-        cryptonite ==0.30.*,+        cryptonite >=0.30 && <0.31,         data-ordlist >=0.4.7.0 && <0.5,         deepseq >=1.4.6.1 && <1.5,         directory >=1.3.6.2 && <1.4,-        dlist ==1.0.*,+        dlist >=1.0 && <1.1,         edit-distance >=0.2.2.1 && <0.3,         file-embed >=0.0.15.0 && <0.1,         filepath >=1.4.2.2 && <1.5,-        fsnotify >=0.3.0.1 && <0.4,         Glob >=0.10.2 && <0.11,         haskeline >=0.8.2 && <0.9,         language-javascript ==0.7.0.0,@@ -531,28 +536,26 @@         regex-tdfa >=1.3.1.2 && <1.4,         safe >=0.3.19 && <0.4,         scientific >=0.3.7.0 && <0.4,-        semigroups ==0.20.*,+        semigroups >=0.20 && <0.21,         semialign >=1.2.0.1 && <1.3,         sourcemap >=0.1.7 && <0.2,-        split >=0.2.3.4 && <0.3,         stm >=2.5.0.2 && <2.6,         stringsearch >=0.3.6.6 && <0.4,-        syb >=0.7.2.1 && <0.8,+        template-haskell >=2.18.0.0 && <2.19,         text >=1.2.5.0 && <1.3,         these >=1.1.1.1 && <1.2,         time >=1.11.1.1 && <1.12,         transformers >=0.5.6.2 && <0.6,         transformers-base >=0.4.6 && <0.5,-        transformers-compat >=0.7.1 && <0.8,-        typed-process >=0.2.10.1 && <0.3,-        unordered-containers >=0.2.19.1 && <0.3,         utf8-string >=1.0.2 && <1.1,         vector >=0.12.3.1 && <0.13,         witherable >=0.4.2 && <0.5,-        purescript -any,+        purescript,         generic-random >=1.5.0.1 && <1.6,         hspec ==2.9.2,         HUnit >=1.6.2.0 && <1.7,         newtype >=0.2.2.0 && <0.3,         QuickCheck >=2.14.2 && <2.15,-        regex-base >=0.94.0.2 && <0.95+        regex-base >=0.94.0.2 && <0.95,+        split >=0.2.3.4 && <0.3,+        typed-process >=0.2.10.1 && <0.3

@@ -147,7 +147,7 @@ importPrim :: Module -> Module importPrim =   let-    primModName = C.Prim+    primModName = C.M_Prim   in     addDefaultImport (Qualified (ByModuleName primModName) primModName)       . addDefaultImport (Qualified ByNullSourcePos primModName)

@@ -82,7 +82,7 @@ --    ] of -- @ ----- Which of the above 13 commas function as the separaters between the+-- Which of the above 13 commas function as the separators between the -- case binders (e.g. @one@) in the outermost @case ... of@ context? -- -- ### The Solution

@@ -201,7 +201,7 @@   goWs a _ = a    goSpace a !n (' ' : ls) = goSpace a (n + 1) ls-  goSpace a !n ls = goWs (Space n : a) ls+  goSpace a n ls = goWs (Space n : a) ls    isBlockComment = Parser $ \inp _ ksucc ->     case Text.uncons inp of@@ -725,7 +725,7 @@ digitsToScientific = go 0 . reverse   where   go !exp is [] = (digitsToInteger (reverse is), exp)-  go !exp is (f : fs) = go (exp - 1) (f : is) fs+  go exp is (f : fs) = go (exp - 1) (f : is) fs  isSymbolChar :: Char -> Bool isSymbolChar c = (c `elem` (":!#$%&*+./<=>?@\\^|-~" :: String)) || (not (Char.isAscii c) && Char.isSymbol c)

@@ -52,7 +52,7 @@ -- module. moduleToJs   :: forall m-   . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)+   . (MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)   => Module Ann   -> Maybe PSString   -> m AST.Module@@ -232,7 +232,7 @@  moduleBindToJs   :: forall m-   . (Monad m, MonadReader Options m, MonadSupply m, MonadWriter Any m, MonadError MultipleErrors m)+   . (MonadReader Options m, MonadSupply m, MonadWriter Any m, MonadError MultipleErrors m)   => ModuleName   -> Bind Ann   -> m [AST]@@ -393,7 +393,7 @@   -- | Generate code in the simplified JavaScript intermediate representation for a reference to a   -- variable that may have a qualified name.   qualifiedToJS :: (a -> Ident) -> Qualified a -> AST-  qualifiedToJS f (Qualified (ByModuleName C.Prim) a) = AST.Var Nothing . runIdent $ f a+  qualifiedToJS f (Qualified (ByModuleName C.M_Prim) a) = AST.Var Nothing . runIdent $ f a   qualifiedToJS f (Qualified (ByModuleName mn') a) | mn /= mn' = AST.ModuleAccessor Nothing mn' . mkString . T.concatMap identCharToText . runIdent $ f a   qualifiedToJS f (Qualified _ a) = AST.Var Nothing $ identToJs (f a) 

@@ -1,28 +0,0 @@-module Language.PureScript.Constants.Data.Foldable where--import Data.String (IsString)-import Language.PureScript.Names--foldl :: forall a. (IsString a) => a-foldl = "foldl"--foldr :: forall a. (IsString a) => a-foldr = "foldr"--foldMap :: forall a. (IsString a) => a-foldMap = "foldMap"--pattern DataFoldable :: ModuleName-pattern DataFoldable = ModuleName "Data.Foldable"--pattern Foldable :: Qualified (ProperName 'ClassName)-pattern Foldable = Qualified (ByModuleName DataFoldable) (ProperName "Foldable")--identFoldl :: Qualified Ident-identFoldl = Qualified (ByModuleName DataFoldable) (Ident foldl)--identFoldr :: Qualified Ident-identFoldr = Qualified (ByModuleName DataFoldable) (Ident foldr)--identFoldMap :: Qualified Ident-identFoldMap = Qualified (ByModuleName DataFoldable) (Ident foldMap)

@@ -1,39 +0,0 @@-module Language.PureScript.Constants.Data.Generic.Rep where--import Language.PureScript.Names--pattern DataGenericRep :: ModuleName-pattern DataGenericRep = ModuleName "Data.Generic.Rep"--pattern Generic :: Qualified (ProperName 'ClassName)-pattern Generic = Qualified (ByModuleName DataGenericRep) (ProperName "Generic")--to :: Qualified Ident-to = Qualified (ByModuleName DataGenericRep) (Ident "to")--from :: Qualified Ident-from = Qualified (ByModuleName DataGenericRep) (Ident "from")--pattern NoConstructors :: Qualified (ProperName a)-pattern NoConstructors = Qualified (ByModuleName DataGenericRep) (ProperName "NoConstructors")--pattern NoArguments :: Qualified (ProperName a)-pattern NoArguments = Qualified (ByModuleName DataGenericRep) (ProperName "NoArguments")--pattern Sum :: Qualified (ProperName a)-pattern Sum = Qualified (ByModuleName DataGenericRep) (ProperName "Sum")--pattern Inl :: Qualified (ProperName a)-pattern Inl = Qualified (ByModuleName DataGenericRep) (ProperName "Inl")--pattern Inr :: Qualified (ProperName a)-pattern Inr = Qualified (ByModuleName DataGenericRep) (ProperName "Inr")--pattern Product :: Qualified (ProperName a)-pattern Product = Qualified (ByModuleName DataGenericRep) (ProperName "Product")--pattern Constructor :: Qualified (ProperName a)-pattern Constructor = Qualified (ByModuleName DataGenericRep) (ProperName "Constructor")--pattern Argument :: Qualified (ProperName a)-pattern Argument = Qualified (ByModuleName DataGenericRep) (ProperName "Argument")

@@ -1,6 +0,0 @@-module Language.PureScript.Constants.Data.Newtype where--import Language.PureScript.Names--pattern Newtype :: Qualified (ProperName 'ClassName)-pattern Newtype = Qualified (ByModuleName (ModuleName "Data.Newtype")) (ProperName "Newtype")

@@ -1,19 +0,0 @@-module Language.PureScript.Constants.Data.Traversable where--import Data.String (IsString)-import Language.PureScript.Names--traverse :: forall a. (IsString a) => a-traverse = "traverse"--sequence :: forall a. (IsString a) => a-sequence = "sequence"--pattern DataTraversable :: ModuleName-pattern DataTraversable = ModuleName "Data.Traversable"--pattern Traversable :: Qualified (ProperName 'ClassName)-pattern Traversable = Qualified (ByModuleName DataTraversable) (ProperName "Traversable")--identTraverse :: Qualified Ident-identTraverse = Qualified (ByModuleName DataTraversable) (Ident traverse)

@@ -0,0 +1,264 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TemplateHaskell #-}+-- | Various constants which refer to things in the Prelude and other core libraries+module Language.PureScript.Constants.Libs where++import qualified Protolude as P++import Data.String (IsString)+import Language.PureScript.PSString (PSString)+import qualified Language.PureScript.Constants.TH as TH++-- Core lib values++stRefValue :: forall a. IsString a => a+stRefValue = "value"++-- Type Class Dictionary Names++data EffectDictionaries = EffectDictionaries+  { edApplicativeDict :: PSString+  , edBindDict :: PSString+  , edMonadDict :: PSString+  , edWhile :: PSString+  , edUntil :: PSString+  }++effDictionaries :: EffectDictionaries+effDictionaries = EffectDictionaries+  { edApplicativeDict = "applicativeEff"+  , edBindDict = "bindEff"+  , edMonadDict = "monadEff"+  , edWhile = "whileE"+  , edUntil = "untilE"+  }++effectDictionaries :: EffectDictionaries+effectDictionaries = EffectDictionaries+  { edApplicativeDict = "applicativeEffect"+  , edBindDict = "bindEffect"+  , edMonadDict = "monadEffect"+  , edWhile = "whileE"+  , edUntil = "untilE"+  }++stDictionaries :: EffectDictionaries+stDictionaries = EffectDictionaries+  { edApplicativeDict = "applicativeST"+  , edBindDict = "bindST"+  , edMonadDict = "monadST"+  , edWhile = "while"+  , edUntil = "until"+  }++$(TH.declare do++  -- purescript-prelude+  +  TH.mod "Control.Apply" do+    TH.asIdent do TH.asString do TH.var "apply"++  TH.mod "Control.Applicative" do+    TH.asIdent do TH.asPair do TH.asString do TH.var "pure"++  TH.mod "Control.Bind" do+    TH.asPair do+      TH.asString do+        TH.var "bind"+        TH.cls "Discard" ; TH.var "discard"++      TH.var "discardUnit"++  TH.mod "Control.Category" do+    TH.asPair do+      TH.asIdent do TH.var "identity"++      TH.var "categoryFn"++  TH.mod "Control.Semigroupoid" do+    TH.asPair do+      TH.vars ["compose", "composeFlipped"]+      TH.var "semigroupoidFn"++  TH.mod "Data.Bounded" do+    TH.asPair do+      TH.vars ["bottom", "top"]+      TH.var "boundedBoolean"++  TH.mod "Data.Eq" do+    TH.cls "Eq" ; TH.asIdent do TH.asPair do TH.asString do TH.var "eq"+    TH.cls "Eq1" ; TH.asIdent do TH.asString do TH.var "eq1"+    TH.asPair do+      TH.var "notEq"++      TH.var "eqBoolean"+      TH.var "eqChar"+      TH.var "eqInt"+      TH.var "eqNumber"+      TH.var "eqString"++  TH.mod "Data.EuclideanRing" do+    TH.asPair do+      TH.var "div"++      TH.var "euclideanRingNumber"++  TH.mod "Data.Function" do+    TH.asIdent do+      TH.prefixWith "function" do TH.vars ["apply", "applyFlipped"]+      TH.var "const"+      TH.var "flip"++  TH.mod "Data.Functor" do+    TH.cls "Functor" ; TH.asIdent do TH.asString do TH.var "map"++  TH.mod "Data.Generic.Rep" do+    TH.cls "Generic" ; TH.asIdent do TH.vars ["from", "to"]+    TH.ntys ["Argument", "Constructor", "NoArguments", "NoConstructors", "Product"]+    TH.dty "Sum" ["Inl", "Inr"]++  TH.mod "Data.HeytingAlgebra" do+    TH.asPair do+      TH.asIdent do TH.vars ["conj", "disj", "not"]++      TH.var "heytingAlgebraBoolean"++  TH.mod "Data.Monoid" do+    TH.asIdent do TH.var "mempty"++  TH.mod "Data.Ord" do+    TH.cls "Ord" ; TH.asIdent do TH.asString do TH.var "compare"+    TH.cls "Ord1" ; TH.asIdent do TH.asString do TH.var "compare1"+    TH.asPair do+      TH.vars ["greaterThan", "greaterThanOrEq", "lessThan", "lessThanOrEq"]++      TH.var "ordBoolean"+      TH.var "ordChar"+      TH.var "ordInt"+      TH.var "ordNumber"+      TH.var "ordString"++  TH.mod "Data.Ordering" do+    TH.dty "Ordering" ["EQ", "GT", "LT"]++  TH.mod "Data.Reflectable" do+    TH.cls "Reflectable"++  TH.mod "Data.Ring" do+    TH.asPair do+      TH.asString do TH.vars ["negate", "sub"]++      TH.var "ringInt"+      TH.var "ringNumber"++  TH.mod "Data.Semigroup" do+    TH.asPair do+      TH.asIdent do TH.var "append"++      TH.var "semigroupString"++  TH.mod "Data.Semiring" do+    TH.asPair do+      TH.vars ["add", "mul", "one", "zero"]++      TH.var "semiringInt"+      TH.var "semiringNumber"++  TH.mod "Data.Symbol" do+    TH.cls "IsSymbol"++  -- purescript-arrays++  TH.mod "Data.Array" do+    TH.asPair do TH.var "unsafeIndex"++  -- purescript-bifunctors++  TH.mod "Data.Bifunctor" do+    TH.cls "Bifunctor" ; TH.asIdent do TH.asString do TH.var "bimap"+    TH.asIdent do TH.vars ["lmap", "rmap"]++  -- purescript-contravariant++  TH.mod "Data.Functor.Contravariant" do+    TH.cls "Contravariant" ; TH.asIdent do TH.asString do TH.var "cmap"++  -- purescript-eff++  TH.mod "Control.Monad.Eff" (P.pure ())++  TH.mod "Control.Monad.Eff.Uncurried" do+    TH.asPair do TH.vars ["mkEffFn", "runEffFn"]++  -- purescript-effect++  TH.mod "Effect" (P.pure ())++  TH.mod "Effect.Uncurried" do+    TH.asPair do TH.vars ["mkEffectFn", "runEffectFn"]++  -- purescript-foldable-traversable++  TH.mod "Data.Bifoldable" do+    TH.cls "Bifoldable" ; TH.asIdent do TH.asString do TH.vars ["bifoldMap", "bifoldl", "bifoldr"]++  TH.mod "Data.Bitraversable" do+    TH.cls "Bitraversable" ; TH.asString do TH.asIdent (TH.var "bitraverse"); TH.var "bisequence"+    TH.asIdent do+      TH.vars ["ltraverse", "rtraverse"]++  TH.mod "Data.Foldable" do+    TH.cls "Foldable" ; TH.asIdent do TH.asString do TH.vars ["foldMap", "foldl", "foldr"]++  TH.mod "Data.Traversable" do+    TH.cls "Traversable" ; TH.asString do TH.asIdent (TH.var "traverse") ; TH.var "sequence"++  -- purescript-functions++  TH.mod "Data.Function.Uncurried" do+    TH.asPair do TH.asString do TH.vars ["mkFn", "runFn"]++  -- purescript-integers++  TH.mod "Data.Int.Bits" do+    TH.asPair do+      TH.var "and"+      TH.var "complement"+      TH.var "or"+      TH.var "shl"+      TH.var "shr"+      TH.var "xor"+      TH.var "zshr"++  -- purescript-newtype++  TH.mod "Data.Newtype" do+    TH.cls "Newtype"++  -- purescript-partial++  TH.mod "Partial.Unsafe" do+    TH.asIdent do TH.asPair do TH.var "unsafePartial"++  -- purescript-profunctor++  TH.mod "Data.Profunctor" do+    TH.cls "Profunctor" ; TH.asIdent do TH.asString do TH.var "dimap"+    TH.asIdent do+      TH.var "lcmap"+      TH.prefixWith "profunctor" do TH.var "rmap"++  -- purescript-st++  TH.mod "Control.Monad.ST.Internal" do+    TH.asPair do TH.vars ["modify", "new", "read", "run", "write"]++  TH.mod "Control.Monad.ST.Uncurried" do+    TH.asPair do TH.vars ["mkSTFn", "runSTFn"]++  -- purescript-unsafe-coerce++  TH.mod "Unsafe.Coerce" do+    TH.asPair do TH.var "unsafeCoerce"++  )

@@ -1,455 +0,0 @@--- | Various constants which refer to things in the Prelude-module Language.PureScript.Constants.Prelude where--import Data.String (IsString)-import Language.PureScript.PSString (PSString)-import Language.PureScript.Names---- Operators--apply :: forall a. (IsString a) => a-apply = "apply"--applyFlipped :: forall a. (IsString a) => a-applyFlipped = "applyFlipped"--append :: forall a. (IsString a) => a-append = "append"--mempty :: forall a. (IsString a) => a-mempty = "mempty"--bind :: forall a. (IsString a) => a-bind = "bind"--discard :: forall a. (IsString a) => a-discard = "discard"--pattern Discard :: Qualified (ProperName 'ClassName)-pattern Discard = Qualified (ByModuleName ControlBind) (ProperName "Discard")--add :: forall a. (IsString a) => a-add = "add"--sub :: forall a. (IsString a) => a-sub = "sub"--mul :: forall a. (IsString a) => a-mul = "mul"--div :: forall a. (IsString a) => a-div = "div"--lessThan :: forall a. (IsString a) => a-lessThan = "lessThan"--greaterThan :: forall a. (IsString a) => a-greaterThan = "greaterThan"--lessThanOrEq :: forall a. (IsString a) => a-lessThanOrEq = "lessThanOrEq"--greaterThanOrEq :: forall a. (IsString a) => a-greaterThanOrEq = "greaterThanOrEq"--eq :: forall a. (IsString a) => a-eq = "eq"--eq1 :: forall a. (IsString a) => a-eq1 = "eq1"--notEq :: forall a. (IsString a) => a-notEq = "notEq"--compare :: forall a. (IsString a) => a-compare = "compare"--compare1 :: forall a. (IsString a) => a-compare1 = "compare1"--conj :: forall a. (IsString a) => a-conj = "conj"--disj :: forall a. (IsString a) => a-disj = "disj"--unsafeIndex :: forall a. (IsString a) => a-unsafeIndex = "unsafeIndex"--or :: forall a. (IsString a) => a-or = "or"--and :: forall a. (IsString a) => a-and = "and"--xor :: forall a. (IsString a) => a-xor = "xor"--compose :: forall a. (IsString a) => a-compose = "compose"--composeFlipped :: forall a. (IsString a) => a-composeFlipped = "composeFlipped"--map :: forall a. (IsString a) => a-map = "map"---- Functions--negate :: forall a. (IsString a) => a-negate = "negate"--not :: forall a. (IsString a) => a-not = "not"--shl :: forall a. (IsString a) => a-shl = "shl"--shr :: forall a. (IsString a) => a-shr = "shr"--zshr :: forall a. (IsString a) => a-zshr = "zshr"--complement :: forall a. (IsString a) => a-complement = "complement"--identity :: forall a. (IsString a) => a-identity = "identity"---- Prelude Values--zero :: forall a. (IsString a) => a-zero = "zero"--one :: forall a. (IsString a) => a-one = "one"--bottom :: forall a. (IsString a) => a-bottom = "bottom"--top :: forall a. (IsString a) => a-top = "top"--pure' :: forall a. (IsString a) => a-pure' = "pure"---- Core lib values--runST :: forall a. (IsString a) => a-runST = "run"--stRefValue :: forall a. (IsString a) => a-stRefValue = "value"--newSTRef :: forall a. (IsString a) => a-newSTRef = "new"--readSTRef :: forall a. (IsString a) => a-readSTRef = "read"--writeSTRef :: forall a. (IsString a) => a-writeSTRef = "write"--modifySTRef :: forall a. (IsString a) => a-modifySTRef = "modify"--mkFn :: forall a. (IsString a) => a-mkFn = "mkFn"--runFn :: forall a. (IsString a) => a-runFn = "runFn"--mkEffFn :: forall a. (IsString a) => a-mkEffFn = "mkEffFn"--runEffFn :: forall a. (IsString a) => a-runEffFn = "runEffFn"--mkEffectFn :: forall a. (IsString a) => a-mkEffectFn = "mkEffectFn"--runEffectFn :: forall a. (IsString a) => a-runEffectFn = "runEffectFn"--mkSTFn :: forall a. (IsString a) => a-mkSTFn = "mkSTFn"--runSTFn :: forall a. (IsString a) => a-runSTFn = "runSTFn"---- Type Class Dictionary Names--data EffectDictionaries = EffectDictionaries-  { edApplicativeDict :: PSString-  , edBindDict :: PSString-  , edMonadDict :: PSString-  , edWhile :: PSString-  , edUntil :: PSString-  }--effDictionaries :: EffectDictionaries-effDictionaries = EffectDictionaries-  { edApplicativeDict = "applicativeEff"-  , edBindDict = "bindEff"-  , edMonadDict = "monadEff"-  , edWhile = "whileE"-  , edUntil = "untilE"-  }--effectDictionaries :: EffectDictionaries-effectDictionaries = EffectDictionaries-  { edApplicativeDict = "applicativeEffect"-  , edBindDict = "bindEffect"-  , edMonadDict = "monadEffect"-  , edWhile = "whileE"-  , edUntil = "untilE"-  }--stDictionaries :: EffectDictionaries-stDictionaries = EffectDictionaries-  { edApplicativeDict = "applicativeST"-  , edBindDict = "bindST"-  , edMonadDict = "monadST"-  , edWhile = "while"-  , edUntil = "until"-  }--discardUnitDictionary :: forall a. (IsString a) => a-discardUnitDictionary = "discardUnit"--semiringNumber :: forall a. (IsString a) => a-semiringNumber = "semiringNumber"--semiringInt :: forall a. (IsString a) => a-semiringInt = "semiringInt"--ringNumber :: forall a. (IsString a) => a-ringNumber = "ringNumber"--ringInt :: forall a. (IsString a) => a-ringInt = "ringInt"--euclideanRingNumber :: forall a. (IsString a) => a-euclideanRingNumber = "euclideanRingNumber"--ordBoolean :: forall a. (IsString a) => a-ordBoolean = "ordBoolean"--ordNumber :: forall a. (IsString a) => a-ordNumber = "ordNumber"--ordInt :: forall a. (IsString a) => a-ordInt = "ordInt"--ordString :: forall a. (IsString a) => a-ordString = "ordString"--ordChar :: forall a. (IsString a) => a-ordChar = "ordChar"--eqNumber :: forall a. (IsString a) => a-eqNumber = "eqNumber"--eqInt :: forall a. (IsString a) => a-eqInt = "eqInt"--eqString :: forall a. (IsString a) => a-eqString = "eqString"--eqChar :: forall a. (IsString a) => a-eqChar = "eqChar"--eqBoolean :: forall a. (IsString a) => a-eqBoolean = "eqBoolean"--boundedBoolean :: forall a. (IsString a) => a-boundedBoolean = "boundedBoolean"--heytingAlgebraBoolean :: forall a. (IsString a) => a-heytingAlgebraBoolean = "heytingAlgebraBoolean"--semigroupString :: forall a. (IsString a) => a-semigroupString = "semigroupString"--semigroupoidFn :: forall a. (IsString a) => a-semigroupoidFn = "semigroupoidFn"--categoryFn :: forall a. (IsString a) => a-categoryFn = "categoryFn"---- Data.Symbol--pattern DataSymbol :: ModuleName-pattern DataSymbol = ModuleName "Data.Symbol"--pattern IsSymbol :: Qualified (ProperName 'ClassName)-pattern IsSymbol = Qualified (ByModuleName DataSymbol) (ProperName "IsSymbol")--pattern DataReflectable :: ModuleName-pattern DataReflectable = ModuleName "Data.Reflectable"--pattern Reflectable :: Qualified (ProperName 'ClassName)-pattern Reflectable = Qualified (ByModuleName DataReflectable) (ProperName "Reflectable")--pattern DataOrdering :: ModuleName-pattern DataOrdering = ModuleName "Data.Ordering"--pattern DataFunctionUncurried :: ModuleName-pattern DataFunctionUncurried = ModuleName "Data.Function.Uncurried"--pattern PartialUnsafe :: ModuleName-pattern PartialUnsafe = ModuleName "Partial.Unsafe"--pattern Ordering :: Qualified (ProperName 'TypeName)-pattern Ordering = Qualified (ByModuleName DataOrdering) (ProperName "Ordering")--pattern LT :: Qualified (ProperName 'ConstructorName)-pattern LT = Qualified (ByModuleName DataOrdering) (ProperName "LT")--pattern EQ :: Qualified (ProperName 'ConstructorName)-pattern EQ = Qualified (ByModuleName DataOrdering) (ProperName "EQ")--pattern GT :: Qualified (ProperName 'ConstructorName)-pattern GT = Qualified (ByModuleName DataOrdering) (ProperName "GT")--pattern DataArray :: ModuleName-pattern DataArray = ModuleName "Data.Array"--pattern Eff :: ModuleName-pattern Eff = ModuleName "Control.Monad.Eff"--pattern Effect :: ModuleName-pattern Effect = ModuleName "Effect"--pattern ST :: ModuleName-pattern ST = ModuleName "Control.Monad.ST.Internal"--pattern ControlApply :: ModuleName-pattern ControlApply = ModuleName "Control.Apply"--pattern Apply :: Qualified (ProperName 'ClassName)-pattern Apply = Qualified (ByModuleName ControlApply) (ProperName "Apply")--identApply :: Qualified Ident-identApply = Qualified (ByModuleName ControlApply) (Ident apply)--pattern ControlApplicative :: ModuleName-pattern ControlApplicative = ModuleName "Control.Applicative"--pattern Applicative :: Qualified (ProperName 'ClassName)-pattern Applicative = Qualified (ByModuleName ControlApplicative) (ProperName "Applicative")--identPure :: Qualified Ident-identPure = Qualified (ByModuleName ControlApplicative) (Ident pure')--pattern ControlSemigroupoid :: ModuleName-pattern ControlSemigroupoid = ModuleName "Control.Semigroupoid"--pattern ControlBind :: ModuleName-pattern ControlBind = ModuleName "Control.Bind"--pattern ControlCategory :: ModuleName-pattern ControlCategory = ModuleName "Control.Category"--pattern Category :: Qualified (ProperName 'ClassName)-pattern Category = Qualified (ByModuleName ControlCategory) (ProperName "Category")--identIdentity :: Qualified Ident-identIdentity = Qualified (ByModuleName ControlCategory) (Ident identity)--pattern ControlMonadEffUncurried :: ModuleName-pattern ControlMonadEffUncurried = ModuleName "Control.Monad.Eff.Uncurried"--pattern EffectUncurried :: ModuleName-pattern EffectUncurried = ModuleName "Effect.Uncurried"--pattern ControlMonadSTUncurried :: ModuleName-pattern ControlMonadSTUncurried = ModuleName "Control.Monad.ST.Uncurried"--pattern DataBounded :: ModuleName-pattern DataBounded = ModuleName "Data.Bounded"--pattern DataSemigroup :: ModuleName-pattern DataSemigroup = ModuleName "Data.Semigroup"--identAppend :: Qualified Ident-identAppend = Qualified (ByModuleName DataSemigroup) (Ident append)--pattern DataMonoid :: ModuleName-pattern DataMonoid = ModuleName "Data.Monoid"--identMempty :: Qualified Ident-identMempty = Qualified (ByModuleName DataMonoid) (Ident mempty)--pattern DataHeytingAlgebra :: ModuleName-pattern DataHeytingAlgebra = ModuleName "Data.HeytingAlgebra"--pattern DataEq :: ModuleName-pattern DataEq = ModuleName "Data.Eq"--pattern Eq :: Qualified (ProperName 'ClassName)-pattern Eq = Qualified (ByModuleName DataEq) (ProperName "Eq")--pattern Eq1 :: Qualified (ProperName 'ClassName)-pattern Eq1 = Qualified (ByModuleName DataEq) (ProperName "Eq1")--identEq :: Qualified Ident-identEq = Qualified (ByModuleName DataEq) (Ident eq)--identEq1 :: Qualified Ident-identEq1 = Qualified (ByModuleName DataEq) (Ident eq1)--pattern DataOrd :: ModuleName-pattern DataOrd = ModuleName "Data.Ord"--pattern Ord :: Qualified (ProperName 'ClassName)-pattern Ord = Qualified (ByModuleName DataOrd) (ProperName "Ord")--pattern Ord1 :: Qualified (ProperName 'ClassName)-pattern Ord1 = Qualified (ByModuleName DataOrd) (ProperName "Ord1")--identCompare :: Qualified Ident-identCompare = Qualified (ByModuleName DataOrd) (Ident compare)--identCompare1 :: Qualified Ident-identCompare1 = Qualified (ByModuleName DataOrd) (Ident compare1)--pattern DataFunctor :: ModuleName-pattern DataFunctor = ModuleName "Data.Functor"--pattern Functor :: Qualified (ProperName 'ClassName)-pattern Functor = Qualified (ByModuleName DataFunctor) (ProperName "Functor")--identMap :: Qualified Ident-identMap = Qualified (ByModuleName DataFunctor) (Ident map)--pattern DataSemiring :: ModuleName-pattern DataSemiring = ModuleName "Data.Semiring"--pattern DataRing :: ModuleName-pattern DataRing = ModuleName "Data.Ring"--pattern DataEuclideanRing :: ModuleName-pattern DataEuclideanRing = ModuleName "Data.EuclideanRing"--pattern DataFunction :: ModuleName-pattern DataFunction = ModuleName "Data.Function"--identFlip :: Qualified Ident-identFlip = Qualified (ByModuleName DataFunction) (Ident flip)--flip :: forall a. (IsString a) => a-flip = "flip"--pattern DataIntBits :: ModuleName-pattern DataIntBits = ModuleName "Data.Int.Bits"--unsafePartial :: forall a. (IsString a) => a-unsafePartial = "unsafePartial"--pattern UnsafeCoerce :: ModuleName-pattern UnsafeCoerce = ModuleName "Unsafe.Coerce"--unsafeCoerceFn :: forall a. (IsString a) => a-unsafeCoerceFn = "unsafeCoerce"

@@ -1,195 +1,57 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TemplateHaskell #-} -- | Various constants which refer to things in Prim module Language.PureScript.Constants.Prim where -import Data.String (IsString) import Language.PureScript.Names---- Prim values--undefined :: forall a. (IsString a) => a-undefined = "undefined"---- Prim--pattern Prim :: ModuleName-pattern Prim = ModuleName "Prim"--pattern Partial :: Qualified (ProperName 'ClassName)-pattern Partial = Qualified (ByModuleName Prim) (ProperName "Partial")--pattern Record :: Qualified (ProperName 'TypeName)-pattern Record = Qualified (ByModuleName Prim) (ProperName "Record")--pattern Type :: Qualified (ProperName 'TypeName)-pattern Type = Qualified (ByModuleName Prim) (ProperName "Type")--pattern Constraint :: Qualified (ProperName 'TypeName)-pattern Constraint = Qualified (ByModuleName Prim) (ProperName "Constraint")--pattern Function :: Qualified (ProperName 'TypeName)-pattern Function = Qualified (ByModuleName Prim) (ProperName "Function")--pattern Array :: Qualified (ProperName 'TypeName)-pattern Array = Qualified (ByModuleName Prim) (ProperName "Array")--pattern Row :: Qualified (ProperName 'TypeName)-pattern Row = Qualified (ByModuleName Prim) (ProperName "Row")---- Prim.Boolean--pattern PrimBoolean :: ModuleName-pattern PrimBoolean = ModuleName "Prim.Boolean"--booleanTrue :: Qualified (ProperName 'TypeName)-booleanTrue = Qualified (ByModuleName PrimBoolean) (ProperName "True")--booleanFalse :: Qualified (ProperName 'TypeName)-booleanFalse = Qualified (ByModuleName PrimBoolean) (ProperName "False")---- Prim.Coerce--pattern PrimCoerce :: ModuleName-pattern PrimCoerce = ModuleName "Prim.Coerce"--pattern Coercible :: Qualified (ProperName 'ClassName)-pattern Coercible = Qualified (ByModuleName PrimCoerce) (ProperName "Coercible")---- Prim.Ordering--pattern PrimOrdering :: ModuleName-pattern PrimOrdering = ModuleName "Prim.Ordering"--orderingLT :: Qualified (ProperName 'TypeName)-orderingLT = Qualified (ByModuleName PrimOrdering) (ProperName "LT")--orderingEQ :: Qualified (ProperName 'TypeName)-orderingEQ = Qualified (ByModuleName PrimOrdering) (ProperName "EQ")--orderingGT :: Qualified (ProperName 'TypeName)-orderingGT = Qualified (ByModuleName PrimOrdering) (ProperName "GT")---- Prim.Row--pattern PrimRow :: ModuleName-pattern PrimRow = ModuleName "Prim.Row"--pattern RowUnion :: Qualified (ProperName 'ClassName)-pattern RowUnion = Qualified (ByModuleName PrimRow) (ProperName "Union")--pattern RowNub :: Qualified (ProperName 'ClassName)-pattern RowNub = Qualified (ByModuleName PrimRow) (ProperName "Nub")--pattern RowCons :: Qualified (ProperName 'ClassName)-pattern RowCons = Qualified (ByModuleName PrimRow) (ProperName "Cons")--pattern RowLacks :: Qualified (ProperName 'ClassName)-pattern RowLacks = Qualified (ByModuleName PrimRow) (ProperName "Lacks")---- Prim.RowList--pattern PrimRowList :: ModuleName-pattern PrimRowList = ModuleName "Prim.RowList"--pattern RowToList :: Qualified (ProperName 'ClassName)-pattern RowToList = Qualified (ByModuleName PrimRowList) (ProperName "RowToList")--pattern RowListNil :: Qualified (ProperName 'TypeName)-pattern RowListNil = Qualified (ByModuleName PrimRowList) (ProperName "Nil")--pattern RowListCons :: Qualified (ProperName 'TypeName)-pattern RowListCons = Qualified (ByModuleName PrimRowList) (ProperName "Cons")---- Prim.Int--pattern PrimInt :: ModuleName-pattern PrimInt = ModuleName "Prim.Int"--pattern IntAdd :: Qualified (ProperName 'ClassName)-pattern IntAdd = Qualified (ByModuleName PrimInt) (ProperName "Add")--pattern IntCompare :: Qualified (ProperName 'ClassName)-pattern IntCompare = Qualified (ByModuleName PrimInt) (ProperName "Compare")--pattern IntMul :: Qualified (ProperName 'ClassName)-pattern IntMul = Qualified (ByModuleName PrimInt) (ProperName "Mul")--pattern IntToString :: Qualified (ProperName 'ClassName)-pattern IntToString = Qualified (ByModuleName PrimInt) (ProperName "ToString")+import qualified Language.PureScript.Constants.TH as TH --- Prim.Symbol+$(TH.declare do+  TH.mod "Prim" do+    TH.cls "Partial"+    TH.ty "Array"+    TH.ty "Boolean"+    TH.ty "Char"+    TH.ty "Constraint"+    TH.ty "Function"+    TH.ty "Int"+    TH.ty "Number"+    TH.ty "Record"+    TH.ty "Row"+    TH.ty "String"+    TH.ty "Symbol"+    TH.ty "Type"+    TH.asIdent do TH.asString do TH.var "undefined" -pattern PrimSymbol :: ModuleName-pattern PrimSymbol = ModuleName "Prim.Symbol"+  TH.mod "Prim.Boolean" do+    TH.tys ["False", "True"] -pattern SymbolCompare :: Qualified (ProperName 'ClassName)-pattern SymbolCompare = Qualified (ByModuleName PrimSymbol) (ProperName "Compare")+  TH.mod "Prim.Coerce" do+    TH.cls "Coercible" -pattern SymbolAppend :: Qualified (ProperName 'ClassName)-pattern SymbolAppend = Qualified (ByModuleName PrimSymbol) (ProperName "Append")+  TH.mod "Prim.Int" do+    TH.prefixWith "Int" do TH.clss ["Add", "Compare", "Mul", "ToString"] -pattern SymbolCons :: Qualified (ProperName 'ClassName)-pattern SymbolCons = Qualified (ByModuleName PrimSymbol) (ProperName "Cons")+  TH.mod "Prim.Ordering" do+    TH.prefixWith "Type" do TH.ty "Ordering"+    TH.tys ["EQ", "GT", "LT"] --- Prim.TypeError+  TH.mod "Prim.Row" do+    TH.prefixWith "Row" do TH.clss ["Cons", "Lacks", "Nub", "Union"]+  +  TH.mod "Prim.RowList" do+    TH.ty "RowList"+    TH.cls "RowToList"+    TH.prefixWith "RowList" do TH.tys ["Cons", "Nil"] -pattern PrimTypeError :: ModuleName-pattern PrimTypeError = ModuleName "Prim.TypeError"+  TH.mod "Prim.Symbol" do+    TH.prefixWith "Symbol" do TH.clss ["Append", "Compare", "Cons"] -pattern Fail :: Qualified (ProperName 'ClassName)-pattern Fail = Qualified (ByModuleName PrimTypeError) (ProperName "Fail")+  TH.mod "Prim.TypeError" do+    TH.clss ["Fail", "Warn"]+    TH.tys ["Above", "Beside", "Doc", "Quote", "QuoteLabel", "Text"] -pattern Warn :: Qualified (ProperName 'ClassName)-pattern Warn = Qualified (ByModuleName PrimTypeError) (ProperName "Warn")+  )  primModules :: [ModuleName]-primModules = [Prim, PrimBoolean, PrimCoerce, PrimOrdering, PrimRow, PrimRowList, PrimSymbol, PrimInt, PrimTypeError]--typ :: forall a. (IsString a) => a-typ = "Type"--kindOrdering :: forall a. (IsString a) => a-kindOrdering = "Ordering"--kindRowList :: forall a. (IsString a) => a-kindRowList = "RowList"--symbol :: forall a. (IsString a) => a-symbol = "Symbol"--doc :: forall a. (IsString a) => a-doc = "Doc"--row :: forall a. (IsString a) => a-row = "Row"--constraint :: forall a. (IsString a) => a-constraint = "Constraint"---- Modules--prim :: forall a. (IsString a) => a-prim = "Prim"--moduleBoolean :: forall a. (IsString a) => a-moduleBoolean = "Boolean"--moduleCoerce :: forall a. (IsString a) => a-moduleCoerce = "Coerce"--moduleOrdering :: forall a. (IsString a) => a-moduleOrdering = "Ordering"--moduleRow :: forall a. (IsString a) => a-moduleRow = "Row"--moduleRowList :: forall a. (IsString a) => a-moduleRowList = "RowList"--moduleSymbol :: forall a. (IsString a) => a-moduleSymbol = "Symbol"--moduleInt :: forall a. (IsString a) => a-moduleInt = "Int"--typeError :: forall a. (IsString a) => a-typeError = "TypeError"+primModules = [M_Prim, M_Prim_Boolean, M_Prim_Coerce, M_Prim_Ordering, M_Prim_Row, M_Prim_RowList, M_Prim_Symbol, M_Prim_Int, M_Prim_TypeError]

@@ -0,0 +1,224 @@+{-# LANGUAGE TemplateHaskell #-}+-- | This module implements an eDSL for compactly declaring pattern synonyms+-- representing known PureScript modules and their members.+--+-- The following example assumes this module is imported qualified as TH and+-- the BlockArguments extension is used, both of which I recommend.+--+-- > $(TH.declare do+-- >   TH.mod "Data.Foo" do+-- >     TH.ty "SomeType"+-- >     TH.asIdent do+-- >       TH.var "someVariable"+-- >   )+--+-- will become:+--+-- > pattern M_Data_Foo :: ModuleName+-- > pattern M_Data_Foo = ModuleName "Data.Foo"+-- >+-- > pattern SomeType :: Qualified (ProperName 'TypeName)+-- > pattern SomeType = Qualified (ByModuleName M_Data_Foo) (ProperName "SomeType")+-- >+-- > pattern I_someVariable :: Qualified Ident+-- > pattern I_someVariable = Qualified (ByModuleName M_Data_Foo) (Ident "someVariable")+--+-- All pattern synonyms must start with an uppercase letter. To prevent+-- namespace collisions, different types of pattern are distinguished by a sort+-- of Hungarian notation convention:+--+-- @+--   SomeType   -- a type or class name+--   C_Ctor     -- a constructor name+--   I_name     -- a Qualified Ident+--   M_Data_Foo -- a module name+--   P_name     -- a (module name, polymorphic string) pair+--   S_name     -- a lone polymorphic string (this doesn't contain any module information)+-- @+--+-- I_, P_, and S_ patterns are all optional and have to be enabled with+-- `asIdent`, `asPair`, and `asString` modifiers respectively.+--+-- Finally, to disambiguate between identifiers with the same name (such as+-- Data.Function.apply and Data.Apply.apply), the `prefixWith` modifier will+-- modify the names of the patterns created within it.+--+-- > TH.mod "Data.Function" do+-- >   TH.prefixWith "function" do+-- >     TH.asIdent do+-- >       TH.var "apply"+-- +-- results in:+--+-- > pattern I_functionApply :: Qualified Ident+-- > pattern I_functionApply = Qualified (ByModuleName (M_Data_Function) (Ident "apply")+--+module Language.PureScript.Constants.TH+  ( declare+  , mod+  , cls, clss+  , dty+  , nty, ntys+  , ty, tys+  , var, vars+  , prefixWith+  , asIdent+  , asPair+  , asString+  ) where++import Protolude hiding (Type, mod)++import Control.Lens (over, _head)+import Control.Monad.Trans.RWS (RWS, execRWS)+import Control.Monad.Trans.Writer (Writer, execWriter)+import Control.Monad.Writer.Class (tell)+import Data.String (String)+import Language.Haskell.TH+import Language.PureScript.Names hiding (Name)++-- | Generate pattern synonyms corresponding to the provided PureScript+-- declarations.+declare :: Writer (Q [Dec]) () -> Q [Dec]+declare = execWriter++-- | Declare a module.+mod :: String -> ModDecs -> Writer (Q [Dec]) ()+mod mnStr inner = do+  -- pattern M_Data_Foo :: ModuleName+  -- pattern M_Data_Foo = ModuleName "Data.Foo"+  let mn = mkModuleName mnStr+  tell $ typedPatSyn mn [t| ModuleName |] [p| ModuleName $(litP $ stringL mnStr) |]+  tell $ snd $ execRWS inner (mn, "", []) ()++-- | Declare a type class. The resulting pattern will use the name of the class+-- and have type `Qualified (ProperName 'ClassName)`.+cls :: String -> ModDecs+cls cn = ask >>= \(mn, prefix, _) -> tell $ mkPnPat [t| 'ClassName |] mn prefix cn++-- | Declare a list of type classes; shorthand for repeatedly calling `cls`.+clss :: [String] -> ModDecs+clss = traverse_ cls++-- | Declare a data type, given the name of the type and a list of constructor+-- names. A pattern will be created using the name of the type and have type+-- `Qualified (ProperName 'TypeName)`. A pattern will also be created for each+-- constructor prefixed with "C_", having type `Qualified (ProperName+-- 'ConstructorName)`.+dty :: String -> [String] -> ModDecs+dty dn ctors = ask >>= \(mn, prefix, _) -> do+  tell $ mkPnPat [t| 'TypeName |] mn prefix dn+  tell $ map fold $ traverse (mkPnPat [t| 'ConstructorName |] mn $ "C_" <> prefix) ctors++-- | Declare a data type with a singular constructor named the same as the+-- type, as is commonly the case with newtypes (but this does not require the+-- type to be a newtype in reality). Shorthand for calling `dty`.+nty :: String -> ModDecs+nty tn = dty tn [tn]++-- | Declare a list of data types with singular constructors; shorthand for+-- repeatedly calling `nty`, which itself is shorthand for `dty`.+ntys :: [String] -> ModDecs+ntys = traverse_ nty++-- | Declare a type. The resulting pattern will use the name of the type and have+-- type `Qualified (ProperName 'TypeName)`.+ty :: String -> ModDecs+ty tn = ask >>= \(mn, prefix, _) -> tell $ mkPnPat [t| 'TypeName |] mn prefix tn++-- | Declare a list of types; shorthand for repeatedly calling `ty`.+tys :: [String] -> ModDecs+tys = traverse_ ty++-- | Declare a variable, function, named instance, or generally a lower-case+-- value member of a module. The patterns created depend on which of `asPair`,+-- `asIdent`, or `asString` are used in the enclosing context.+var :: String -> ModDecs+var nm = ask >>= \(mn, prefix, vtds) -> tell $ foldMap (\f -> f mn prefix nm) vtds++-- | Declare a list of variables; shorthand for repeatedly calling `var`.+vars :: [String] -> ModDecs+vars = traverse_ var++-- | For every variable declared within, create a pattern synonym prefixed+-- with "P_" having type `forall a. (Eq a, IsString a) => (ModuleName, a)`.+asPair :: ModDecs -> ModDecs+asPair = local $ addToVars mkPairDec++-- | For every variable declared within, cerate a pattern synonym prefixed+-- with "I_" having type `Qualified Ident`.+asIdent :: ModDecs -> ModDecs+asIdent = local $ addToVars mkIdentDec++-- | For every variable declared within, cerate a pattern synonym prefixed+-- with "S_" having type `forall a. (Eq a, IsString a) => a`.+asString :: ModDecs -> ModDecs+asString = local $ addToVars mkStringDec++-- | Prefix the names of all enclosed declarations with the provided string, to+-- prevent collisions with other identifiers. For example,+-- `prefixWith "function"` would turn `I_apply` into `I_functionApply`, and+-- `C_Example` into `C_FunctionExample`.+prefixWith :: String -> ModDecs -> ModDecs+prefixWith = local . applyPrefix++-- Internals start here++type ModDecs = RWS (Name, String, [VarToDec]) (Q [Dec]) () ()+type VarToDec = Name -> String -> String -> Q [Dec]++addToVars :: VarToDec -> (a, b, [VarToDec]) -> (a, b, [VarToDec])+addToVars f (a, b, fs) = (a, b, f : fs)++applyPrefix :: String -> (a, String, c) -> (a, String, c)+applyPrefix prefix (a, prefix', c) = (a, camelAppend prefix' prefix, c)++cap :: String -> String+cap = over _head toUpper++camelAppend :: String -> String -> String+camelAppend l r = if null l then r else l <> cap r++-- "Data.Foo" -> M_Data_Foo+mkModuleName :: String -> Name+mkModuleName = mkName . ("M_" <>) . map (\case '.' -> '_'; other -> other)++-- "I_" -> "fn" -> "foo" -> I_fnFoo+-- "I_" -> ""   -> "foo" -> I_foo+mkPrefixedName :: String -> String -> String -> Name+mkPrefixedName tag prefix = mkName . (tag <>) . camelAppend prefix++-- 'TypeName -> M_Data_Foo -> "Function" -> "Foo" ->+--   pattern FunctionFoo :: Qualified (ProperName 'TypeName)+--   pattern FunctionFoo = Qualified (ByModuleName M_Data_Foo) (ProperName "Foo")+mkPnPat :: Q Type -> VarToDec+mkPnPat pnType mn prefix str = typedPatSyn (mkName $ cap prefix <> str)+  [t| Qualified (ProperName $pnType) |]+  [p| Qualified (ByModuleName $(conP mn [])) (ProperName $(litP $ stringL str)) |]++-- M_Data_Foo -> "function" -> "foo" ->+--   pattern I_functionFoo :: Qualified Ident+--   pattern I_functionFoo = Qualified (ByModuleName M_Data_Foo) (Ident "foo")+mkIdentDec :: VarToDec+mkIdentDec mn prefix str = typedPatSyn (mkPrefixedName "I_" prefix str)+  [t| Qualified Ident |]+  [p| Qualified (ByModuleName $(conP mn [])) (Ident $(litP $ stringL str)) |]++-- M_Data_Foo -> "function" -> "foo" ->+--   pattern P_functionFoo :: forall a. (Eq a, IsString a) => (ModuleName, a)+--   pattern P_functionFoo = (M_Data_Foo, "foo")+mkPairDec :: VarToDec+mkPairDec mn prefix str = typedPatSyn (mkPrefixedName "P_" prefix str)+  [t| forall a. (Eq a, IsString a) => (ModuleName, a) |]+  [p| ($(conP mn []), $(litP $ stringL str)) |]++-- _ -> "function" -> "foo" ->+--   pattern S_functionFoo :: forall a. (Eq a, IsString a) => a+--   pattern S_functionFoo = "foo"+mkStringDec :: VarToDec+mkStringDec _ prefix str = typedPatSyn (mkPrefixedName "S_" prefix str)+  [t| forall a. (Eq a, IsString a) => a |]+  (litP $ stringL str)++typedPatSyn :: Name -> Q Type -> Q Pat -> Q [Dec]+typedPatSyn nm t p = sequence [patSynSigD nm t, patSynD nm (prefixPatSyn []) implBidir p]

@@ -19,7 +19,7 @@  import Language.PureScript.AST.Literals import Language.PureScript.AST.SourcePos (nullSourceSpan)-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C import Language.PureScript.CoreFn.Ann (Ann) import Language.PureScript.CoreFn.Binders import Language.PureScript.CoreFn.Expr

@@ -109,7 +109,7 @@       A.Unused{}             -> True       _                      -> False   exprToCoreFn ss com ty (A.Unused _) =-    Var (ss, com, ty, Nothing) (Qualified (ByModuleName C.Prim) (Ident C.undefined))+    Var (ss, com, ty, Nothing) C.I_undefined   exprToCoreFn _ com ty (A.Var ss ident) =     Var (ss, com, ty, getValueMeta ident) ident   exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =

@@ -17,7 +17,7 @@ import qualified Data.Set as S  import Language.PureScript.AST.SourcePos-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C import Language.PureScript.CoreFn import Language.PureScript.Crash import Language.PureScript.Names@@ -128,8 +128,7 @@       Var a i -> f delay force a i       Abs a i e -> Abs a i <$> snd (if force == Just 0 then go (succ delay) force else go delay $ fmap pred force) e       -- A clumsy hack to preserve TCO in a particular idiom of unsafePartial once seen in Data.Map.Internal, possibly still used elsewhere.-      App a1 e1@(Var _ (Qualified (ByModuleName C.PartialUnsafe) (Ident up))) (Abs a2 i e2) | up == C.unsafePartial-        -> App a1 e1 . Abs a2 i <$> handleExpr' e2+      App a1 e1@(Var _ C.I_unsafePartial) (Abs a2 i e2) -> App a1 e1 . Abs a2 i <$> handleExpr' e2       App a e1 e2 ->         -- `handleApp` is just to handle the constructor application exception         -- somewhat gracefully (i.e., without requiring a deep inspection of@@ -533,7 +532,7 @@    nullAnn = ssAnn nullSourceSpan   runtimeLazy = Var nullAnn . Qualified ByNullSourcePos $ InternalIdent RuntimeLazyFactory-  runFn3 = Var nullAnn . Qualified (ByModuleName C.DataFunctionUncurried) . Ident $ C.runFn <> "3"+  runFn3 = Var nullAnn . Qualified (ByModuleName C.M_Data_Function_Uncurried) . Ident $ C.S_runFn <> "3"   strLit = Literal nullAnn . StringLiteral . mkString    lazifyIdent = \case

@@ -11,10 +11,9 @@ import Language.PureScript.CoreFn.Expr import Language.PureScript.CoreFn.Module import Language.PureScript.CoreFn.Traversals-import Language.PureScript.Names (Ident(..), QualifiedBy(..), Qualified(..)) import Language.PureScript.Label import Language.PureScript.Types-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C  -- |@@ -54,7 +53,7 @@  optimizeDataFunctionApply :: Expr a -> Expr a optimizeDataFunctionApply e = case e of-  (App a (App _ (Var _ (Qualified (ByModuleName C.DataFunction) (Ident fn))) x) y)-    | fn == C.apply -> App a x y-    | fn == C.applyFlipped -> App a y x+  (App a (App _ (Var _ fn) x) y)+    | C.I_functionApply <- fn -> App a x y+    | C.I_functionApplyFlipped <- fn -> App a y x   _ -> e

@@ -60,10 +60,13 @@ removeFromBlock go (Block ss sts) = Block ss (go sts) removeFromBlock _  js = js -isDict :: (ModuleName, PSString) -> AST -> Bool-isDict (moduleName, dictName) (ModuleAccessor _ x y) =-  x == moduleName && y == dictName-isDict _ _ = False+pattern Ref :: (ModuleName, PSString) -> AST+pattern Ref pair <- (refPatternHelper -> Just pair)+-- ideally: pattern Ref (moduleName, refName) <- ModuleAccessor _ moduleName refName+-- but: https://gitlab.haskell.org/ghc/ghc/-/issues/12203+--      https://github.com/ghc-proposals/ghc-proposals/pull/138 -isDict' :: [(ModuleName, PSString)] -> AST -> Bool-isDict' xs js = any (`isDict` js) xs+refPatternHelper :: AST -> Maybe (ModuleName, PSString)+refPatternHelper = \case+  ModuleAccessor _ moduleName refName -> Just (moduleName, refName)+  _ -> Nothing

@@ -18,16 +18,15 @@  import Data.Either (rights) import Data.Maybe (fromMaybe)-import Data.String (IsString, fromString) import Data.Text (Text) import qualified Data.Text as T  import Language.PureScript.Names (ModuleName)-import Language.PureScript.PSString (PSString)+import Language.PureScript.PSString (PSString, mkString) import Language.PureScript.CoreImp.AST import Language.PureScript.CoreImp.Optimizer.Common import Language.PureScript.AST (SourceSpan(..))-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C  -- TODO: Potential bug:@@ -72,7 +71,7 @@   convert :: AST -> AST   convert (App _ (Function _ Nothing [] (Block _ [Return _ ret])) []) = ret   convert (App _ (Function _ Nothing idents (Block _ [Return ss ret])) [])-    | not (any (`isReassigned` ret) idents) = replaceIdents (map (, Var ss C.undefined) idents) ret+    | not (any (`isReassigned` ret) idents) = replaceIdents (map (, Var ss C.S_undefined) idents) ret   convert js = js  inlineVariables :: AST -> AST@@ -89,129 +88,121 @@ inlineCommonValues expander = everywhere convert   where   convert :: AST -> AST-  convert (expander -> App ss fn [dict])-    | isDict' [semiringNumber, semiringInt] dict && isDict fnZero fn = NumericLiteral ss (Left 0)-    | isDict' [semiringNumber, semiringInt] dict && isDict fnOne fn = NumericLiteral ss (Left 1)-    | isDict boundedBoolean dict && isDict fnBottom fn = BooleanLiteral ss False-    | isDict boundedBoolean dict && isDict fnTop fn = BooleanLiteral ss True-  convert (App ss (expander -> App _ fn [dict]) [x])-    | isDict ringInt dict && isDict fnNegate fn = Binary ss BitwiseOr (Unary ss Negate x) (NumericLiteral ss (Left 0))-  convert (App ss (App _ (expander -> App _ fn [dict]) [x]) [y])-    | isDict semiringInt dict && isDict fnAdd fn = intOp ss Add x y-    | isDict semiringInt dict && isDict fnMultiply fn = intOp ss Multiply x y-    | isDict ringInt dict && isDict fnSubtract fn = intOp ss Subtract x y+  convert (expander -> App ss (Ref fn) [Ref dict])+    | dict `elem` [C.P_semiringNumber, C.P_semiringInt], C.P_zero <- fn = NumericLiteral ss (Left 0)+    | dict `elem` [C.P_semiringNumber, C.P_semiringInt], C.P_one <- fn = NumericLiteral ss (Left 1)+    | C.P_boundedBoolean <- dict, C.P_bottom <- fn = BooleanLiteral ss False+    | C.P_boundedBoolean <- dict, C.P_top <- fn = BooleanLiteral ss True+  convert (App ss (expander -> App _ (Ref C.P_negate) [Ref C.P_ringInt]) [x])+    = Binary ss BitwiseOr (Unary ss Negate x) (NumericLiteral ss (Left 0))+  convert (App ss (App _ (expander -> App _ (Ref fn) [Ref dict]) [x]) [y])+    | C.P_semiringInt <- dict, C.P_add <- fn = intOp ss Add x y+    | C.P_semiringInt <- dict, C.P_mul <- fn = intOp ss Multiply x y+    | C.P_ringInt <- dict, C.P_sub <- fn = intOp ss Subtract x y   convert other = other-  fnZero = (C.DataSemiring, C.zero)-  fnOne = (C.DataSemiring, C.one)-  fnBottom = (C.DataBounded, C.bottom)-  fnTop = (C.DataBounded, C.top)-  fnAdd = (C.DataSemiring, C.add)-  fnMultiply = (C.DataSemiring, C.mul)-  fnSubtract = (C.DataRing, C.sub)-  fnNegate = (C.DataRing, C.negate)   intOp ss op x y = Binary ss BitwiseOr (Binary ss op x y) (NumericLiteral ss (Left 0))  inlineCommonOperators :: (AST -> AST) -> AST -> AST inlineCommonOperators expander = everywhereTopDown $ applyAll $-  [ binary semiringNumber opAdd Add-  , binary semiringNumber opMul Multiply+  [ binary C.P_semiringNumber C.P_add Add+  , binary C.P_semiringNumber C.P_mul Multiply -  , binary ringNumber opSub Subtract-  , unary  ringNumber opNegate Negate+  , binary C.P_ringNumber C.P_sub Subtract+  , unary  C.P_ringNumber C.P_negate Negate -  , binary euclideanRingNumber opDiv Divide+  , binary C.P_euclideanRingNumber C.P_div Divide -  , binary eqNumber opEq EqualTo-  , binary eqNumber opNotEq NotEqualTo-  , binary eqInt opEq EqualTo-  , binary eqInt opNotEq NotEqualTo-  , binary eqString opEq EqualTo-  , binary eqString opNotEq NotEqualTo-  , binary eqChar opEq EqualTo-  , binary eqChar opNotEq NotEqualTo-  , binary eqBoolean opEq EqualTo-  , binary eqBoolean opNotEq NotEqualTo+  , binary C.P_eqNumber C.P_eq EqualTo+  , binary C.P_eqNumber C.P_notEq NotEqualTo+  , binary C.P_eqInt C.P_eq EqualTo+  , binary C.P_eqInt C.P_notEq NotEqualTo+  , binary C.P_eqString C.P_eq EqualTo+  , binary C.P_eqString C.P_notEq NotEqualTo+  , binary C.P_eqChar C.P_eq EqualTo+  , binary C.P_eqChar C.P_notEq NotEqualTo+  , binary C.P_eqBoolean C.P_eq EqualTo+  , binary C.P_eqBoolean C.P_notEq NotEqualTo -  , binary ordBoolean opLessThan LessThan-  , binary ordBoolean opLessThanOrEq LessThanOrEqualTo-  , binary ordBoolean opGreaterThan GreaterThan-  , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo-  , binary ordChar opLessThan LessThan-  , binary ordChar opLessThanOrEq LessThanOrEqualTo-  , binary ordChar opGreaterThan GreaterThan-  , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo-  , binary ordInt opLessThan LessThan-  , binary ordInt opLessThanOrEq LessThanOrEqualTo-  , binary ordInt opGreaterThan GreaterThan-  , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo-  , binary ordNumber opLessThan LessThan-  , binary ordNumber opLessThanOrEq LessThanOrEqualTo-  , binary ordNumber opGreaterThan GreaterThan-  , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo-  , binary ordString opLessThan LessThan-  , binary ordString opLessThanOrEq LessThanOrEqualTo-  , binary ordString opGreaterThan GreaterThan-  , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo+  , binary C.P_ordBoolean C.P_lessThan LessThan+  , binary C.P_ordBoolean C.P_lessThanOrEq LessThanOrEqualTo+  , binary C.P_ordBoolean C.P_greaterThan GreaterThan+  , binary C.P_ordBoolean C.P_greaterThanOrEq GreaterThanOrEqualTo+  , binary C.P_ordChar C.P_lessThan LessThan+  , binary C.P_ordChar C.P_lessThanOrEq LessThanOrEqualTo+  , binary C.P_ordChar C.P_greaterThan GreaterThan+  , binary C.P_ordChar C.P_greaterThanOrEq GreaterThanOrEqualTo+  , binary C.P_ordInt C.P_lessThan LessThan+  , binary C.P_ordInt C.P_lessThanOrEq LessThanOrEqualTo+  , binary C.P_ordInt C.P_greaterThan GreaterThan+  , binary C.P_ordInt C.P_greaterThanOrEq GreaterThanOrEqualTo+  , binary C.P_ordNumber C.P_lessThan LessThan+  , binary C.P_ordNumber C.P_lessThanOrEq LessThanOrEqualTo+  , binary C.P_ordNumber C.P_greaterThan GreaterThan+  , binary C.P_ordNumber C.P_greaterThanOrEq GreaterThanOrEqualTo+  , binary C.P_ordString C.P_lessThan LessThan+  , binary C.P_ordString C.P_lessThanOrEq LessThanOrEqualTo+  , binary C.P_ordString C.P_greaterThan GreaterThan+  , binary C.P_ordString C.P_greaterThanOrEq GreaterThanOrEqualTo -  , binary semigroupString opAppend Add+  , binary C.P_semigroupString C.P_append Add -  , binary heytingAlgebraBoolean opConj And-  , binary heytingAlgebraBoolean opDisj Or-  , unary  heytingAlgebraBoolean opNot Not+  , binary C.P_heytingAlgebraBoolean C.P_conj And+  , binary C.P_heytingAlgebraBoolean C.P_disj Or+  , unary  C.P_heytingAlgebraBoolean C.P_not Not -  , binary' C.DataIntBits C.or BitwiseOr-  , binary' C.DataIntBits C.and BitwiseAnd-  , binary' C.DataIntBits C.xor BitwiseXor-  , binary' C.DataIntBits C.shl ShiftLeft-  , binary' C.DataIntBits C.shr ShiftRight-  , binary' C.DataIntBits C.zshr ZeroFillShiftRight-  , unary'  C.DataIntBits C.complement BitwiseNot+  , binary' C.P_or BitwiseOr+  , binary' C.P_and BitwiseAnd+  , binary' C.P_xor BitwiseXor+  , binary' C.P_shl ShiftLeft+  , binary' C.P_shr ShiftRight+  , binary' C.P_zshr ZeroFillShiftRight+  , unary'  C.P_complement BitwiseNot -  , inlineNonClassFunction (isModFnWithDict (C.DataArray, C.unsafeIndex)) $ flip (Indexer Nothing)+  , inlineNonClassFunction (isModFnWithDict C.P_unsafeIndex) $ flip (Indexer Nothing)   ] ++   [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ] ++-  [ fn | i <- [0..10], fn <- [ mkEffFn C.ControlMonadEffUncurried C.mkEffFn i, runEffFn C.ControlMonadEffUncurried C.runEffFn i ] ] ++-  [ fn | i <- [0..10], fn <- [ mkEffFn C.EffectUncurried C.mkEffectFn i, runEffFn C.EffectUncurried C.runEffectFn i ] ] ++-  [ fn | i <- [0..10], fn <- [ mkEffFn C.ControlMonadSTUncurried C.mkSTFn i, runEffFn C.ControlMonadSTUncurried C.runSTFn i ] ]+  [ fn | i <- [0..10], fn <- [ mkEffFn C.P_mkEffFn i, runEffFn C.P_runEffFn i ] ] +++  [ fn | i <- [0..10], fn <- [ mkEffFn C.P_mkEffectFn i, runEffFn C.P_runEffectFn i ] ] +++  [ fn | i <- [0..10], fn <- [ mkEffFn C.P_mkSTFn i, runEffFn C.P_runSTFn i ] ]   where   binary :: (ModuleName, PSString) -> (ModuleName, PSString) -> BinaryOperator -> AST -> AST-  binary dict fns op = convert where+  binary dict fn op = convert where     convert :: AST -> AST-    convert (App ss (App _ (expander -> App _ fn [dict']) [x]) [y]) | isDict dict dict' && isDict fns fn = Binary ss op x y+    convert (App ss (App _ (expander -> App _ (Ref fn') [Ref dict']) [x]) [y]) | dict == dict', fn == fn' = Binary ss op x y     convert other = other-  binary' :: ModuleName -> PSString -> BinaryOperator -> AST -> AST-  binary' moduleName opString op = convert where+  binary' :: (ModuleName, PSString) -> BinaryOperator -> AST -> AST+  binary' fn op = convert where     convert :: AST -> AST-    convert (App ss (App _ fn [x]) [y]) | isDict (moduleName, opString) fn = Binary ss op x y+    convert (App ss (App _ (Ref fn') [x]) [y]) | fn == fn' = Binary ss op x y     convert other = other   unary :: (ModuleName, PSString) -> (ModuleName, PSString) -> UnaryOperator -> AST -> AST-  unary dicts fns op = convert where+  unary dict fn op = convert where     convert :: AST -> AST-    convert (App ss (expander -> App _ fn [dict']) [x]) | isDict dicts dict' && isDict fns fn = Unary ss op x+    convert (App ss (expander -> App _ (Ref fn') [Ref dict']) [x]) | dict == dict', fn == fn' = Unary ss op x     convert other = other-  unary' :: ModuleName -> PSString -> UnaryOperator -> AST -> AST-  unary' moduleName fnName op = convert where+  unary' :: (ModuleName, PSString) -> UnaryOperator -> AST -> AST+  unary' fn op = convert where     convert :: AST -> AST-    convert (App ss fn [x]) | isDict (moduleName, fnName) fn = Unary ss op x+    convert (App ss (Ref fn') [x]) | fn == fn' = Unary ss op x     convert other = other    mkFn :: Int -> AST -> AST-  mkFn = mkFn' C.DataFunctionUncurried C.mkFn $ \ss1 ss2 ss3 args js ->+  mkFn = mkFn' C.P_mkFn $ \ss1 ss2 ss3 args js ->     Function ss1 Nothing args (Block ss2 [Return ss3 js]) -  mkEffFn :: ModuleName -> Text -> Int -> AST -> AST-  mkEffFn modName fnName = mkFn' modName fnName $ \ss1 ss2 ss3 args js ->+  mkEffFn :: (ModuleName, PSString) -> Int -> AST -> AST+  mkEffFn mkFn_ = mkFn' mkFn_ $ \ss1 ss2 ss3 args js ->     Function ss1 Nothing args (Block ss2 [Return ss3 (App ss3 js [])]) -  mkFn' :: ModuleName -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST-  mkFn' modName fnName res 0 = convert where+  mkFn' :: (ModuleName, PSString) -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST+  mkFn' mkFn_ res 0 = convert where     convert :: AST -> AST-    convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 [Return s3 js])]) | isNFn modName fnName 0 mkFnN =+    convert (App _ (Ref mkFnN) [Function s1 Nothing [_] (Block s2 [Return s3 js])]) | isNFn mkFn_ 0 mkFnN =       res s1 s2 s3 [] js     convert other = other-  mkFn' modName fnName res n = convert where+  mkFn' mkFn_ res n = convert where     convert :: AST -> AST-    convert orig@(App ss mkFnN [fn]) | isNFn modName fnName n mkFnN =+    convert orig@(App ss (Ref mkFnN) [fn]) | isNFn mkFn_ n mkFnN =       case collectArgs n [] fn of         Just (args, [Return ss' ret]) -> res ss ss ss' args ret         _ -> orig@@ -221,25 +212,23 @@     collectArgs m acc (Function _ Nothing [oneArg] (Block _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret     collectArgs _ _   _ = Nothing -  isNFn :: ModuleName -> Text -> Int -> AST -> Bool-  isNFn expectMod prefix n (ModuleAccessor _ modName name) | modName == expectMod =-    name == fromString (T.unpack prefix <> show n)-  isNFn _ _ _ _ = False+  isNFn :: (ModuleName, PSString) -> Int -> (ModuleName, PSString) -> Bool+  isNFn prefix n fn = fmap (<> mkString (T.pack $ show n)) prefix == fn    runFn :: Int -> AST -> AST-  runFn = runFn' C.DataFunctionUncurried C.runFn App+  runFn = runFn' C.P_runFn App -  runEffFn :: ModuleName -> Text -> Int -> AST -> AST-  runEffFn modName fnName = runFn' modName fnName $ \ss fn acc ->+  runEffFn :: (ModuleName, PSString) -> Int -> AST -> AST+  runEffFn runFn_ = runFn' runFn_ $ \ss fn acc ->     Function ss Nothing [] (Block ss [Return ss (App ss fn acc)]) -  runFn' :: ModuleName -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST-  runFn' modName runFnName res n = convert where+  runFn' :: (ModuleName, PSString) -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST+  runFn' runFn_ res n = convert where     convert :: AST -> AST     convert js = fromMaybe js $ go n [] js      go :: Int -> [AST] -> AST -> Maybe AST-    go 0 acc (App ss runFnN [fn]) | isNFn modName runFnName n runFnN && length acc == n =+    go 0 acc (App ss (Ref runFnN) [fn]) | isNFn runFn_ n runFnN && length acc == n =       Just $ res ss fn acc     go m acc (App _ lhs [arg]) = go (m - 1) (arg : acc) lhs     go _ _   _ = Nothing@@ -251,8 +240,7 @@     convert other = other    isModFnWithDict :: (ModuleName, PSString) -> AST -> Bool-  isModFnWithDict (m, op) (App _ (ModuleAccessor _ m' op') [Var _ _]) =-    m == m' && op == op'+  isModFnWithDict fn (App _ (Ref fn') [Var _ _]) = fn == fn'   isModFnWithDict _ _ = False  -- (f <<< g $ x) = f (g x)@@ -261,11 +249,11 @@ inlineFnComposition expander = everywhereTopDownM convert   where   convert :: AST -> m AST-  convert (App s1 (App s2 (App _ (expander -> App _ fn [dict']) [x]) [y]) [z])-    | isFnCompose dict' fn = return $ App s1 x [App s2 y [z]]-    | isFnComposeFlipped dict' fn = return $ App s2 y [App s1 x [z]]-  convert app@(App ss (App _ (expander -> App _ fn [dict']) _) _)-    | isFnCompose dict' fn || isFnComposeFlipped dict' fn = mkApps ss <$> goApps app <*> freshName+  convert (App s1 (App s2 (App _ (expander -> App _ (Ref fn) [Ref C.P_semigroupoidFn]) [x]) [y]) [z])+    | C.P_compose <- fn = return $ App s1 x [App s2 y [z]]+    | C.P_composeFlipped <- fn = return $ App s2 y [App s1 x [z]]+  convert app@(App ss (App _ (expander -> App _ (Ref fn) [Ref C.P_semigroupoidFn]) _) _)+    | fn `elem` [C.P_compose, C.P_composeFlipped] = mkApps ss <$> goApps app <*> freshName   convert other = return other    mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST@@ -279,151 +267,28 @@   mkApp = either id $ \(name, arg) -> Var (getSourceSpan arg) name    goApps :: AST -> m [Either AST (Text, AST)]-  goApps (App _ (App _ (expander -> App _ fn [dict']) [x]) [y])-    | isFnCompose dict' fn = mappend <$> goApps x <*> goApps y-    | isFnComposeFlipped dict' fn = mappend <$> goApps y <*> goApps x+  goApps (App _ (App _ (expander -> App _ (Ref fn) [Ref C.P_semigroupoidFn]) [x]) [y])+    | C.P_compose <- fn = mappend <$> goApps x <*> goApps y+    | C.P_composeFlipped <- fn = mappend <$> goApps y <*> goApps x   goApps app@App {} = pure . Right . (,app) <$> freshName   goApps other = pure [Left other] -  isFnCompose :: AST -> AST -> Bool-  isFnCompose dict' fn = isDict semigroupoidFn dict' && isDict fnCompose fn--  isFnComposeFlipped :: AST -> AST -> Bool-  isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isDict fnComposeFlipped fn--  fnCompose :: forall a. IsString a => (ModuleName, a)-  fnCompose = (C.ControlSemigroupoid, C.compose)--  fnComposeFlipped :: forall a. IsString a => (ModuleName, a)-  fnComposeFlipped = (C.ControlSemigroupoid, C.composeFlipped)- inlineFnIdentity :: (AST -> AST) -> AST -> AST inlineFnIdentity expander = everywhereTopDown convert   where   convert :: AST -> AST-  convert (App _ (expander -> App _ fn [dict]) [x]) | isDict categoryFn dict && isDict fnIdentity fn = x+  convert (App _ (expander -> App _ (Ref C.P_identity) [Ref C.P_categoryFn]) [x]) = x   convert other = other -  fnIdentity :: forall a. IsString a => (ModuleName, a)-  fnIdentity = (C.ControlCategory, C.identity)- inlineUnsafeCoerce :: AST -> AST inlineUnsafeCoerce = everywhereTopDown convert where-  convert (App _ (ModuleAccessor _ C.UnsafeCoerce unsafeCoerceFn) [ comp ])-    | unsafeCoerceFn == C.unsafeCoerceFn-    = comp+  convert (App _ (Ref C.P_unsafeCoerce) [ comp ]) = comp   convert other = other  inlineUnsafePartial :: AST -> AST inlineUnsafePartial = everywhereTopDown convert where-  convert (App ss (ModuleAccessor _ C.PartialUnsafe unsafePartial) [ comp ])-    | unsafePartial == C.unsafePartial+  convert (App ss (Ref C.P_unsafePartial) [ comp ])     -- Apply to undefined here, the application should be optimized away     -- if it is safe to do so-    = App ss comp [ Var ss C.undefined ]+    = App ss comp [ Var ss C.S_undefined ]   convert other = other--semiringNumber :: forall a. IsString a => (ModuleName, a)-semiringNumber = (C.DataSemiring, C.semiringNumber)--semiringInt :: forall a. IsString a => (ModuleName, a)-semiringInt = (C.DataSemiring, C.semiringInt)--ringNumber :: forall a. IsString a => (ModuleName, a)-ringNumber = (C.DataRing, C.ringNumber)--ringInt :: forall a. IsString a => (ModuleName, a)-ringInt = (C.DataRing, C.ringInt)--euclideanRingNumber :: forall a. IsString a => (ModuleName, a)-euclideanRingNumber = (C.DataEuclideanRing, C.euclideanRingNumber)--eqNumber :: forall a. IsString a => (ModuleName, a)-eqNumber = (C.DataEq, C.eqNumber)--eqInt :: forall a. IsString a => (ModuleName, a)-eqInt = (C.DataEq, C.eqInt)--eqString :: forall a. IsString a => (ModuleName, a)-eqString = (C.DataEq, C.eqString)--eqChar :: forall a. IsString a => (ModuleName, a)-eqChar = (C.DataEq, C.eqChar)--eqBoolean :: forall a. IsString a => (ModuleName, a)-eqBoolean = (C.DataEq, C.eqBoolean)--ordBoolean :: forall a. IsString a => (ModuleName, a)-ordBoolean = (C.DataOrd, C.ordBoolean)--ordNumber :: forall a. IsString a => (ModuleName, a)-ordNumber = (C.DataOrd, C.ordNumber)--ordInt :: forall a. IsString a => (ModuleName, a)-ordInt = (C.DataOrd, C.ordInt)--ordString :: forall a. IsString a => (ModuleName, a)-ordString = (C.DataOrd, C.ordString)--ordChar :: forall a. IsString a => (ModuleName, a)-ordChar = (C.DataOrd, C.ordChar)--semigroupString :: forall a. IsString a => (ModuleName, a)-semigroupString = (C.DataSemigroup, C.semigroupString)--boundedBoolean :: forall a. IsString a => (ModuleName, a)-boundedBoolean = (C.DataBounded, C.boundedBoolean)--heytingAlgebraBoolean :: forall a. IsString a => (ModuleName, a)-heytingAlgebraBoolean = (C.DataHeytingAlgebra, C.heytingAlgebraBoolean)--semigroupoidFn :: forall a. IsString a => (ModuleName, a)-semigroupoidFn = (C.ControlSemigroupoid, C.semigroupoidFn)--categoryFn :: forall a. IsString a => (ModuleName, a)-categoryFn = (C.ControlCategory, C.categoryFn)--opAdd :: forall a. IsString a => (ModuleName, a)-opAdd = (C.DataSemiring, C.add)--opMul :: forall a. IsString a => (ModuleName, a)-opMul = (C.DataSemiring, C.mul)--opEq :: forall a. IsString a => (ModuleName, a)-opEq = (C.DataEq, C.eq)--opNotEq :: forall a. IsString a => (ModuleName, a)-opNotEq = (C.DataEq, C.notEq)--opLessThan :: forall a. IsString a => (ModuleName, a)-opLessThan = (C.DataOrd, C.lessThan)--opLessThanOrEq :: forall a. IsString a => (ModuleName, a)-opLessThanOrEq = (C.DataOrd, C.lessThanOrEq)--opGreaterThan :: forall a. IsString a => (ModuleName, a)-opGreaterThan = (C.DataOrd, C.greaterThan)--opGreaterThanOrEq :: forall a. IsString a => (ModuleName, a)-opGreaterThanOrEq = (C.DataOrd, C.greaterThanOrEq)--opAppend :: forall a. IsString a => (ModuleName, a)-opAppend = (C.DataSemigroup, C.append)--opSub :: forall a. IsString a => (ModuleName, a)-opSub = (C.DataRing, C.sub)--opNegate :: forall a. IsString a => (ModuleName, a)-opNegate = (C.DataRing, C.negate)--opDiv :: forall a. IsString a => (ModuleName, a)-opDiv = (C.DataEuclideanRing, C.div)--opConj :: forall a. IsString a => (ModuleName, a)-opConj = (C.DataHeytingAlgebra, C.conj)--opDisj :: forall a. IsString a => (ModuleName, a)-opDisj = (C.DataHeytingAlgebra, C.disj)--opNot :: forall a. IsString a => (ModuleName, a)-opNot = (C.DataHeytingAlgebra, C.not)

@@ -11,7 +11,7 @@ import Language.PureScript.CoreImp.Optimizer.Common import Language.PureScript.Names (ModuleName) import Language.PureScript.PSString (mkString)-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C  -- | Inline type class dictionaries for >>= and return for the Eff monad --@@ -28,13 +28,13 @@ --    ... --  } magicDoEff :: (AST -> AST) -> AST -> AST-magicDoEff = magicDo C.Eff C.effDictionaries+magicDoEff = magicDo C.M_Control_Monad_Eff C.effDictionaries  magicDoEffect :: (AST -> AST) -> AST -> AST-magicDoEffect = magicDo C.Effect C.effectDictionaries+magicDoEffect = magicDo C.M_Effect C.effectDictionaries  magicDoST :: (AST -> AST) -> AST -> AST-magicDoST = magicDo C.ST C.stDictionaries+magicDoST = magicDo C.M_Control_Monad_ST_Internal C.stDictionaries  magicDo :: ModuleName -> C.EffectDictionaries -> (AST -> AST) -> AST -> AST magicDo effectModule C.EffectDictionaries{..} expander = everywhereTopDown convert@@ -68,25 +68,16 @@     App s1 (Function s2 Nothing [] (Block ss (applyReturns `fmap` body))) []   convert other = other   -- Check if an expression represents a monomorphic call to >>= for the Eff monad-  isBind (expander -> App _ fn [dict]) | isDict (effectModule, edBindDict) dict && isBindPoly fn = True+  isBind (expander -> App _ (Ref C.P_bind) [Ref dict]) = (effectModule, edBindDict) == dict   isBind _ = False   -- Check if an expression represents a call to @discard@-  isDiscard (expander -> App _ (expander -> App _ fn [dict1]) [dict2])-    | isDict (C.ControlBind, C.discardUnitDictionary) dict1 &&-      isDict (effectModule, edBindDict) dict2 &&-      isDiscardPoly fn = True+  isDiscard (expander -> App _ (expander -> App _ (Ref C.P_discard) [Ref C.P_discardUnit]) [Ref dict]) = (effectModule, edBindDict) == dict   isDiscard _ = False   -- Check if an expression represents a monomorphic call to pure or return for the Eff applicative-  isPure (expander -> App _ fn [dict]) | isDict (effectModule, edApplicativeDict) dict && isPurePoly fn = True+  isPure (expander -> App _ (Ref C.P_pure) [Ref dict]) = (effectModule, edApplicativeDict) == dict   isPure _ = False-  -- Check if an expression represents the polymorphic >>= function-  isBindPoly = isDict (C.ControlBind, C.bind)-  -- Check if an expression represents the polymorphic pure function-  isPurePoly = isDict (C.ControlApplicative, C.pure')-  -- Check if an expression represents the polymorphic discard function-  isDiscardPoly = isDict (C.ControlBind, C.discard)   -- Check if an expression represents a function in the Effect module-  isEffFunc name (ModuleAccessor _ eff name') = eff == effectModule && name == name'+  isEffFunc name (Ref fn) = (effectModule, name) == fn   isEffFunc _ _ = False    applyReturns :: AST -> AST@@ -102,10 +93,10 @@ inlineST :: AST -> AST inlineST = everywhere convertBlock   where-  -- Look for runST blocks and inline the STRefs there.-  -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then+  -- Look for run blocks and inline the STRefs there.+  -- If all STRefs are used in the scope of the same run, only using { read, write, modify } then   -- we can be more aggressive about inlining, and actually turn STRefs into local variables.-  convertBlock (App s1 f [arg]) | isSTFunc C.runST f =+  convertBlock (App s1 (Ref C.P_run) [arg]) =     let refs = ordNub . findSTRefsIn $ arg         usages = findAllSTUsagesIn arg         allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages@@ -115,28 +106,25 @@   -- Convert a block in a safe way, preserving object wrappers of references,   -- or in a more aggressive way, turning wrappers into local variables depending on the   -- agg(ressive) parameter.-  convert agg (App s1 f [arg]) | isSTFunc C.newSTRef f =+  convert agg (App s1 (Ref C.P_new) [arg]) =    Function s1 Nothing [] (Block s1 [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]])-  convert agg (App _ (App s1 f [ref]) []) | isSTFunc C.readSTRef f =+  convert agg (App _ (App s1 (Ref C.P_read) [ref]) []) =     if agg then ref else Indexer s1 (StringLiteral s1 C.stRefValue) ref-  convert agg (App _ (App _ (App s1 f [arg]) [ref]) []) | isSTFunc C.writeSTRef f =+  convert agg (App _ (App _ (App s1 (Ref C.P_write) [arg]) [ref]) []) =     if agg then Assignment s1 ref arg else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) arg-  convert agg (App _ (App _ (App s1 f [func]) [ref]) []) | isSTFunc C.modifySTRef f =+  convert agg (App _ (App _ (App s1 (Ref C.P_modify) [func]) [ref]) []) =     if agg then Assignment s1 ref (App s1 func [ref]) else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) (App s1 func [Indexer s1 (StringLiteral s1 C.stRefValue) ref])   convert _ other = other-  -- Check if an expression represents a function in the ST module-  isSTFunc name (ModuleAccessor _ C.ST name') = name == name'-  isSTFunc _ _ = False   -- Find all ST Refs initialized in this block   findSTRefsIn = everything (++) isSTRef     where-    isSTRef (VariableIntroduction _ ident (Just (_, App _ (App _ f [_]) []))) | isSTFunc C.newSTRef f = [ident]+    isSTRef (VariableIntroduction _ ident (Just (_, App _ (App _ (Ref C.P_new) [_]) []))) = [ident]     isSTRef _ = []-  -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef+  -- Find all STRefs used as arguments to read, write, modify   findAllSTUsagesIn = everything (++) isSTUsage     where-    isSTUsage (App _ (App _ f [ref]) []) | isSTFunc C.readSTRef f = [ref]-    isSTUsage (App _ (App _ (App _ f [_]) [ref]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]+    isSTUsage (App _ (App _ (Ref C.P_read) [ref]) []) = [ref]+    isSTUsage (App _ (App _ (App _ (Ref f) [_]) [ref]) []) | f `elem` [C.P_write, C.P_modify] = [ref]     isSTUsage _ = []   -- Find all uses of a variable   appearingIn ref = everything (++) isVar

@@ -32,7 +32,7 @@ removeUndefinedApp :: AST -> AST removeUndefinedApp = everywhere convert   where-  convert (App ss fn [Var _ arg]) | arg == C.undefined = App ss fn []+  convert (App ss fn [Var _ C.S_undefined]) = App ss fn []   convert js = js  removeUnusedEffectFreeVars :: [Text] -> [[AST]] -> [[AST]]

@@ -147,8 +147,7 @@   where    collect-    :: (Eq a, Show a)-    => (P.ModuleName -> a -> m (P.ModuleName, [b]))+    :: (P.ModuleName -> a -> m (P.ModuleName, [b]))     -> Map a P.ExportSource     -> m (Map P.ModuleName [b])   collect lookup' exps = do

@@ -13,6 +13,7 @@ import qualified Data.Map as Map import Language.PureScript.Docs.Types +import qualified Language.PureScript.Constants.Prim as P import qualified Language.PureScript.Crash as P import qualified Language.PureScript.Environment as P import qualified Language.PureScript.Names as P@@ -158,27 +159,23 @@   , modReExports = []   } -type NameGen a = Text -> P.Qualified (P.ProperName a)--unsafeLookupOf+unsafeLookup   :: forall v (a :: P.ProperNameType)-  . NameGen a-  -> Map.Map (P.Qualified (P.ProperName a)) v+  . Map.Map (P.Qualified (P.ProperName a)) v   -> String-  -> Text+  -> P.Qualified (P.ProperName a)   -> v-unsafeLookupOf k m errorMsg name = go name+unsafeLookup m errorMsg name = go name   where-  go = fromJust' . flip Map.lookup m . k+  go = fromJust' . flip Map.lookup m    fromJust' (Just x) = x-  fromJust' _ = P.internalError $ errorMsg ++ show name+  fromJust' _ = P.internalError $ errorMsg ++ show (P.runProperName $ P.disqualify name) -lookupPrimTypeKindOf-  :: NameGen 'P.TypeName-  -> Text+lookupPrimTypeKind+  :: P.Qualified (P.ProperName 'P.TypeName)   -> Type'-lookupPrimTypeKindOf k = ($> ()) . fst . unsafeLookupOf k+lookupPrimTypeKind = ($> ()) . fst . unsafeLookup   ( P.primTypes <>     P.primBooleanTypes <>     P.primOrderingTypes <>@@ -187,23 +184,20 @@     P.primTypeErrorTypes   ) "Docs.Prim: No such Prim type: " -primType :: Text -> Text -> Declaration-primType = primTypeOf P.primName--primTypeOf :: NameGen 'P.TypeName -> Text -> Text -> Declaration-primTypeOf gen title comments = Declaration-  { declTitle = title+primType :: P.Qualified (P.ProperName 'P.TypeName) -> Text -> Declaration+primType tn comments = Declaration+  { declTitle = P.runProperName $ P.disqualify tn   , declComments = Just comments   , declSourceSpan = Nothing   , declChildren = []-  , declInfo = ExternDataDeclaration (lookupPrimTypeKindOf gen title) []+  , declInfo = ExternDataDeclaration (lookupPrimTypeKind tn) []   , declKind = Nothing   }  -- | Lookup the TypeClassData of a Prim class. This function is specifically -- not exported because it is partial.-lookupPrimClassOf :: NameGen 'P.ClassName -> Text -> P.TypeClassData-lookupPrimClassOf g = unsafeLookupOf g+lookupPrimClass :: P.Qualified (P.ProperName 'P.ClassName) -> P.TypeClassData+lookupPrimClass = unsafeLookup   ( P.primClasses <>     P.primCoerceClasses <>     P.primRowClasses <>@@ -213,18 +207,15 @@     P.primTypeErrorClasses   ) "Docs.Prim: No such Prim class: " -primClass :: Text -> Text -> Declaration-primClass = primClassOf P.primName--primClassOf :: NameGen 'P.ClassName -> Text -> Text -> Declaration-primClassOf gen title comments = Declaration-  { declTitle = title+primClass :: P.Qualified (P.ProperName 'P.ClassName) -> Text -> Declaration+primClass cn comments = Declaration+  { declTitle = P.runProperName $ P.disqualify cn   , declComments = Just comments   , declSourceSpan = Nothing   , declChildren = []   , declInfo =       let-        tcd = lookupPrimClassOf gen title+        tcd = lookupPrimClass cn         args = fmap (fmap ($> ())) <$> P.typeClassArguments tcd         superclasses = ($> ()) <$> P.typeClassSuperclasses tcd         fundeps = convertFundepsToStrings args (P.typeClassDependencies tcd)@@ -234,13 +225,13 @@   }  kindType :: Declaration-kindType = primType "Type" $ T.unlines+kindType = primType P.Type $ T.unlines   [ "`Type` is the kind of all proper types: those that classify value-level terms."   , "For example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`."   ]  kindConstraint :: Declaration-kindConstraint = primType "Constraint" $ T.unlines+kindConstraint = primType P.Constraint $ T.unlines   [ "`Constraint` is the kind of type class constraints."   , "For example, a type class declaration like this:"   , ""@@ -253,7 +244,7 @@   ]  kindSymbol :: Declaration-kindSymbol = primType "Symbol" $ T.unlines+kindSymbol = primType P.Symbol $ T.unlines   [ "`Symbol` is the kind of type-level strings."   , ""   , "Construct types of this kind using the same literal syntax as documented"@@ -265,7 +256,7 @@   ]  kindRow :: Declaration-kindRow = primType "Row" $ T.unlines+kindRow = primType P.Row $ T.unlines   [ "`Row` is the kind constructor of label-indexed types which map type-level strings to other types."   , "The most common use of `Row` is `Row Type`, a row mapping labels to basic (of kind `Type`) types:"   , ""@@ -277,7 +268,7 @@   ]  function :: Declaration-function = primType "Function" $ T.unlines+function = primType P.Function $ T.unlines   [ "A function, which takes values of the type specified by the first type"   , "parameter, and returns values of the type specified by the second."   , "In the JavaScript backend, this is a standard JavaScript Function."@@ -296,7 +287,7 @@   ]  array :: Declaration-array = primType "Array" $ T.unlines+array = primType P.Array $ T.unlines   [ "An Array: a data structure supporting efficient random access. In"   , "the JavaScript backend, values of this type are represented as JavaScript"   , "Arrays at runtime."@@ -307,7 +298,7 @@   ]  record :: Declaration-record = primType "Record" $ T.unlines+record = primType P.Record $ T.unlines   [ "The type of records whose fields are known at compile time. In the"   , "JavaScript backend, values of this type are represented as JavaScript"   , "Objects at runtime."@@ -329,7 +320,7 @@   ]  number :: Declaration-number = primType "Number" $ T.unlines+number = primType P.Number $ T.unlines   [ "A double precision floating point number (IEEE 754)."   , ""   , "Construct values of this type with literals."@@ -342,7 +333,7 @@   ]  int :: Declaration-int = primType "Int" $ T.unlines+int = primType P.Int $ T.unlines   [ "A 32-bit signed integer. See the `purescript-integers` package for details"   , "of how this is accomplished when compiling to JavaScript."   , ""@@ -375,7 +366,7 @@   ]  string :: Declaration-string = primType "String" $ T.unlines+string = primType P.String $ T.unlines   [ "A String. As in JavaScript, String values represent sequences of UTF-16"   , "code units, which are not required to form a valid encoding of Unicode"   , "text (for example, lone surrogates are permitted)."@@ -397,7 +388,7 @@   ]  char :: Declaration-char = primType "Char" $ T.unlines+char = primType P.Char $ T.unlines   [ "A single character (UTF-16 code unit). The JavaScript representation is a"   , "normal `String`, which is guaranteed to contain one code unit. This means"   , "that astral plane characters (i.e. those with code point values greater"@@ -409,7 +400,7 @@   ]  boolean :: Declaration-boolean = primType "Boolean" $ T.unlines+boolean = primType P.Boolean $ T.unlines   [ "A JavaScript Boolean value."   , ""   , "Construct values of this type with the literals `true` and `false`."@@ -418,7 +409,7 @@   ]  partial :: Declaration-partial = primClass "Partial" $ T.unlines+partial = primClass P.Partial $ T.unlines   [ "The Partial type class is used to indicate that a function is *partial,*"   , "that is, it is not defined for all inputs. In practice, attempting to use"   , "a partial function with a bad input will usually cause an error to be"@@ -428,17 +419,17 @@   ]  booleanTrue :: Declaration-booleanTrue = primTypeOf (P.primSubName "Boolean") "True" $ T.unlines+booleanTrue = primType P.True $ T.unlines   [ "The 'True' boolean type."   ]  booleanFalse :: Declaration-booleanFalse = primTypeOf (P.primSubName "Boolean") "False" $ T.unlines+booleanFalse = primType P.False $ T.unlines   [ "The 'False' boolean type."   ]  coercible :: Declaration-coercible = primClassOf (P.primSubName "Coerce") "Coercible" $ T.unlines+coercible = primClass P.Coercible $ T.unlines   [ "Coercible is a two-parameter type class that has instances for types `a`"   , "and `b` if the compiler can infer that they have the same representation."   , "Coercible constraints are solved according to the following rules:"@@ -494,29 +485,29 @@   ]  kindOrdering :: Declaration-kindOrdering = primTypeOf (P.primSubName "Ordering") "Ordering" $ T.unlines+kindOrdering = primType P.TypeOrdering $ T.unlines   [ "The `Ordering` kind represents the three possibilities of comparing two"   , "types of the same kind: `LT` (less than), `EQ` (equal to), and"   , "`GT` (greater than)."   ]  orderingLT :: Declaration-orderingLT = primTypeOf (P.primSubName "Ordering") "LT" $ T.unlines+orderingLT = primType P.LT $ T.unlines   [ "The 'less than' ordering type."   ]  orderingEQ :: Declaration-orderingEQ = primTypeOf (P.primSubName "Ordering") "EQ" $ T.unlines+orderingEQ = primType P.EQ $ T.unlines   [ "The 'equal to' ordering type."   ]  orderingGT :: Declaration-orderingGT = primTypeOf (P.primSubName "Ordering") "GT" $ T.unlines+orderingGT = primType P.GT $ T.unlines   [ "The 'greater than' ordering type."   ]  union :: Declaration-union = primClassOf (P.primSubName "Row") "Union" $ T.unlines+union = primClass P.RowUnion $ T.unlines   [ "The Union type class is used to compute the union of two rows of types"   , "(left-biased, including duplicates)."   , ""@@ -524,58 +515,58 @@   ]  nub :: Declaration-nub = primClassOf (P.primSubName "Row") "Nub" $ T.unlines+nub = primClass P.RowNub $ T.unlines   [ "The Nub type class is used to remove duplicate labels from rows."   ]  lacks :: Declaration-lacks = primClassOf (P.primSubName "Row") "Lacks" $ T.unlines+lacks = primClass P.RowLacks $ T.unlines   [ "The Lacks type class asserts that a label does not occur in a given row."   ]  rowCons :: Declaration-rowCons = primClassOf (P.primSubName "Row") "Cons" $ T.unlines+rowCons = primClass P.RowCons $ T.unlines   [ "The Cons type class is a 4-way relation which asserts that one row of"   , "types can be obtained from another by inserting a new label/type pair on"   , "the left."   ]  kindRowList :: Declaration-kindRowList = primTypeOf (P.primSubName "RowList") "RowList" $ T.unlines+kindRowList = primType P.RowList $ T.unlines   [ "A type level list representation of a row of types."   ]  rowListCons :: Declaration-rowListCons = primTypeOf (P.primSubName "RowList") "Cons" $ T.unlines+rowListCons = primType P.RowListCons $ T.unlines   [ "Constructs a new `RowList` from a label, a type, and an existing tail"   , "`RowList`.  E.g: `Cons \"x\" Int (Cons \"y\" Int Nil)`."   ]  rowListNil :: Declaration-rowListNil = primTypeOf (P.primSubName "RowList") "Nil" $ T.unlines+rowListNil = primType P.RowListNil $ T.unlines   [ "The empty `RowList`."   ]  rowToList :: Declaration-rowToList = primClassOf (P.primSubName "RowList") "RowToList" $ T.unlines+rowToList = primClass P.RowToList $ T.unlines   [ "Compiler solved type class for generating a `RowList` from a closed row"   , "of types.  Entries are sorted by label and duplicates are preserved in"   , "the order they appeared in the row."   ]  symbolAppend :: Declaration-symbolAppend = primClassOf (P.primSubName "Symbol") "Append" $ T.unlines+symbolAppend = primClass P.SymbolAppend $ T.unlines   [ "Compiler solved type class for appending `Symbol`s together."   ]  symbolCompare :: Declaration-symbolCompare = primClassOf (P.primSubName "Symbol") "Compare" $ T.unlines+symbolCompare = primClass P.SymbolCompare $ T.unlines   [ "Compiler solved type class for comparing two `Symbol`s."   , "Produces an `Ordering`."   ]  symbolCons :: Declaration-symbolCons = primClassOf (P.primSubName "Symbol") "Cons" $ T.unlines+symbolCons = primClass P.SymbolCons $ T.unlines   [ "Compiler solved type class for either splitting up a symbol into its"   , "head and tail or for combining a head and tail into a new symbol."   , "Requires the head to be a single character and the combined string"@@ -583,28 +574,28 @@   ]  intAdd :: Declaration-intAdd = primClassOf (P.primSubName "Int") "Add" $ T.unlines+intAdd = primClass P.IntAdd $ T.unlines   [ "Compiler solved type class for adding type-level `Int`s."   ]  intCompare :: Declaration-intCompare = primClassOf (P.primSubName "Int") "Compare" $ T.unlines+intCompare = primClass P.IntCompare $ T.unlines   [ "Compiler solved type class for comparing two type-level `Int`s."   , "Produces an `Ordering`."   ]  intMul :: Declaration-intMul = primClassOf (P.primSubName "Int") "Mul" $ T.unlines+intMul = primClass P.IntMul $ T.unlines   [ "Compiler solved type class for multiplying type-level `Int`s."   ]  intToString :: Declaration-intToString = primClassOf (P.primSubName "Int") "ToString" $ T.unlines+intToString = primClass P.IntToString $ T.unlines   [ "Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`)."   ]  fail :: Declaration-fail = primClassOf (P.primSubName "TypeError") "Fail" $ T.unlines+fail = primClass P.Fail $ T.unlines   [ "The Fail type class is part of the custom type errors feature. To provide"   , "a custom type error when someone tries to use a particular instance,"   , "write that instance out with a Fail constraint."@@ -614,7 +605,7 @@   ]  warn :: Declaration-warn = primClassOf (P.primSubName "TypeError") "Warn" $ T.unlines+warn = primClass P.Warn $ T.unlines   [ "The Warn type class allows a custom compiler warning to be displayed."   , ""   , "For more information, see"@@ -622,7 +613,7 @@   ]  kindDoc :: Declaration-kindDoc = primTypeOf (P.primSubName "TypeError") "Doc" $ T.unlines+kindDoc = primType P.Doc $ T.unlines   [ "`Doc` is the kind of type-level documents."   , ""   , "This kind is used with the `Fail` and `Warn` type classes."@@ -630,7 +621,7 @@   ]  textDoc :: Declaration-textDoc = primTypeOf (P.primSubName "TypeError") "Text" $ T.unlines+textDoc = primType P.Text $ T.unlines   [ "The Text type constructor makes a Doc from a Symbol"   , "to be used in a custom type error."   , ""@@ -639,7 +630,7 @@   ]  quoteDoc :: Declaration-quoteDoc = primTypeOf (P.primSubName "TypeError") "Quote" $ T.unlines+quoteDoc = primType P.Quote $ T.unlines   [ "The Quote type constructor renders any concrete type as a Doc"   , "to be used in a custom type error."   , ""@@ -648,7 +639,7 @@   ]  quoteLabelDoc :: Declaration-quoteLabelDoc = primTypeOf (P.primSubName "TypeError") "QuoteLabel" $ T.unlines+quoteLabelDoc = primType P.QuoteLabel $ T.unlines   [ "The `QuoteLabel` type constructor will produce a `Doc` when given a `Symbol`. When the resulting `Doc` is rendered"   , "for a `Warn` or `Fail` constraint, a syntactically valid label will be produced, escaping with quotes as needed."   , ""@@ -657,7 +648,7 @@   ]  besideDoc :: Declaration-besideDoc = primTypeOf (P.primSubName "TypeError") "Beside" $ T.unlines+besideDoc = primType P.Beside $ T.unlines   [ "The Beside type constructor combines two Docs horizontally"   , "to be used in a custom type error."   , ""@@ -666,7 +657,7 @@   ]  aboveDoc :: Declaration-aboveDoc = primTypeOf (P.primSubName "TypeError") "Above" $ T.unlines+aboveDoc = primType P.Above $ T.unlines   [ "The Above type constructor combines two Docs vertically"   , "in a custom type error."   , ""

@@ -9,6 +9,7 @@ import Data.Aeson ((.=), (.:)) import qualified Data.Aeson as A import Data.Foldable (find, fold)+import Data.Functor ((<&>)) import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Map as M@@ -279,81 +280,62 @@     "newtype" -> return Newtype     other -> fail $ "invalid type: '" ++ T.unpack other ++ "'" --- | Construct a ProperName in the Prim module-primName :: Text -> Qualified (ProperName a)-primName = Qualified (ByModuleName C.Prim) . ProperName---- | Construct a 'ProperName' in the @Prim.NAME@ module.-primSubName :: Text -> Text -> Qualified (ProperName a)-primSubName sub =-  Qualified (ByModuleName $ ModuleName $ C.prim <> "." <> sub) . ProperName--primKind :: Text -> SourceType-primKind = primTy--primSubKind :: Text -> Text -> SourceType-primSubKind sub = TypeConstructor nullSourceAnn . primSubName sub- -- | Kind of ground types kindType :: SourceType-kindType = primKind C.typ+kindType = srcTypeConstructor C.Type  kindConstraint :: SourceType-kindConstraint = primKind C.constraint+kindConstraint = srcTypeConstructor C.Constraint  kindSymbol :: SourceType-kindSymbol = primKind C.symbol+kindSymbol = srcTypeConstructor C.Symbol  kindDoc :: SourceType-kindDoc = primSubKind C.typeError C.doc+kindDoc = srcTypeConstructor C.Doc  kindOrdering :: SourceType-kindOrdering = primSubKind C.moduleOrdering C.kindOrdering+kindOrdering = srcTypeConstructor C.TypeOrdering  kindRowList :: SourceType -> SourceType-kindRowList = TypeApp nullSourceAnn (primSubKind C.moduleRowList C.kindRowList)+kindRowList = TypeApp nullSourceAnn (srcTypeConstructor C.RowList)  kindRow :: SourceType -> SourceType-kindRow = TypeApp nullSourceAnn (primKind C.row)+kindRow = TypeApp nullSourceAnn (srcTypeConstructor C.Row)  kindOfREmpty :: SourceType kindOfREmpty = tyForall "k" kindType (kindRow (tyVar "k")) --- | Construct a type in the Prim module-primTy :: Text -> SourceType-primTy = TypeConstructor nullSourceAnn . primName- -- | Type constructor for functions tyFunction :: SourceType-tyFunction = primTy "Function"+tyFunction = srcTypeConstructor C.Function  -- | Type constructor for strings tyString :: SourceType-tyString = primTy "String"+tyString = srcTypeConstructor C.String  -- | Type constructor for strings tyChar :: SourceType-tyChar = primTy "Char"+tyChar = srcTypeConstructor C.Char  -- | Type constructor for numbers tyNumber :: SourceType-tyNumber = primTy "Number"+tyNumber = srcTypeConstructor C.Number  -- | Type constructor for integers tyInt :: SourceType-tyInt = primTy "Int"+tyInt = srcTypeConstructor C.Int  -- | Type constructor for booleans tyBoolean :: SourceType-tyBoolean = primTy "Boolean"+tyBoolean = srcTypeConstructor C.Boolean  -- | Type constructor for arrays tyArray :: SourceType-tyArray = primTy "Array"+tyArray = srcTypeConstructor C.Array  -- | Type constructor for records tyRecord :: SourceType-tyRecord = primTy "Record"+tyRecord = srcTypeConstructor C.Record  tyVar :: Text -> SourceType tyVar = TypeVar nullSourceAnn@@ -370,12 +352,12 @@ (-:>) = function infixr 4 -:> -primClass :: Qualified (ProperName 'TypeName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]+primClass :: Qualified (ProperName 'ClassName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))] primClass name mkKind =   [ let k = mkKind kindConstraint-    in (name, (k, ExternData (nominalRolesForKind k)))+    in (coerceProperName <$> name, (k, ExternData (nominalRolesForKind k)))   , let k = mkKind kindType-    in (dictTypeName <$> name, (k, TypeSynonym))+    in (dictTypeName . coerceProperName <$> name, (k, TypeSynonym))   ]  -- | The primitive types in the external environment with their@@ -384,19 +366,19 @@ primTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primTypes =   M.fromList-    [ (primName "Type",             (kindType, ExternData []))-    , (primName "Constraint",       (kindType, ExternData []))-    , (primName "Symbol",           (kindType, ExternData []))-    , (primName "Row",              (kindType -:> kindType, ExternData [Phantom]))-    , (primName "Function",         (kindType -:> kindType -:> kindType, ExternData [Representational, Representational]))-    , (primName "Array",            (kindType -:> kindType, ExternData [Representational]))-    , (primName "Record",           (kindRow kindType -:> kindType, ExternData [Representational]))-    , (primName "String",           (kindType, ExternData []))-    , (primName "Char",             (kindType, ExternData []))-    , (primName "Number",           (kindType, ExternData []))-    , (primName "Int",              (kindType, ExternData []))-    , (primName "Boolean",          (kindType, ExternData []))-    , (primName "Partial",          (kindConstraint, ExternData []))+    [ (C.Type,                         (kindType, ExternData []))+    , (C.Constraint,                   (kindType, ExternData []))+    , (C.Symbol,                       (kindType, ExternData []))+    , (C.Row,                          (kindType -:> kindType, ExternData [Phantom]))+    , (C.Function,                     (kindType -:> kindType -:> kindType, ExternData [Representational, Representational]))+    , (C.Array,                        (kindType -:> kindType, ExternData [Representational]))+    , (C.Record,                       (kindRow kindType -:> kindType, ExternData [Representational]))+    , (C.String,                       (kindType, ExternData []))+    , (C.Char,                         (kindType, ExternData []))+    , (C.Number,                       (kindType, ExternData []))+    , (C.Int,                          (kindType, ExternData []))+    , (C.Boolean,                      (kindType, ExternData []))+    , (C.Partial <&> coerceProperName, (kindConstraint, ExternData []))     ]  -- | This 'Map' contains all of the prim types from all Prim modules.@@ -416,75 +398,75 @@ primBooleanTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primBooleanTypes =   M.fromList-    [ (primSubName C.moduleBoolean "True", (tyBoolean, ExternData []))-    , (primSubName C.moduleBoolean "False", (tyBoolean, ExternData []))+    [ (C.True, (tyBoolean, ExternData []))+    , (C.False, (tyBoolean, ExternData []))     ]  primCoerceTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primCoerceTypes =   M.fromList $ mconcat-    [ primClass (primSubName C.moduleCoerce "Coercible") (\kind -> tyForall "k" kindType $ tyVar "k" -:> tyVar "k" -:> kind)+    [ primClass C.Coercible (\kind -> tyForall "k" kindType $ tyVar "k" -:> tyVar "k" -:> kind)     ]  primOrderingTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primOrderingTypes =   M.fromList-    [ (primSubName C.moduleOrdering "Ordering", (kindType, ExternData []))-    , (primSubName C.moduleOrdering "LT", (kindOrdering, ExternData []))-    , (primSubName C.moduleOrdering "EQ", (kindOrdering, ExternData []))-    , (primSubName C.moduleOrdering "GT", (kindOrdering, ExternData []))+    [ (C.TypeOrdering, (kindType, ExternData []))+    , (C.LT, (kindOrdering, ExternData []))+    , (C.EQ, (kindOrdering, ExternData []))+    , (C.GT, (kindOrdering, ExternData []))     ]  primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primRowTypes =   M.fromList $ mconcat-    [ primClass (primSubName C.moduleRow "Union") (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind)-    , primClass (primSubName C.moduleRow "Nub")   (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind)-    , primClass (primSubName C.moduleRow "Lacks") (\kind -> tyForall "k" kindType $ kindSymbol -:> kindRow (tyVar "k") -:> kind)-    , primClass (primSubName C.moduleRow "Cons")  (\kind -> tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind)+    [ primClass C.RowUnion (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind)+    , primClass C.RowNub   (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind)+    , primClass C.RowLacks (\kind -> tyForall "k" kindType $ kindSymbol -:> kindRow (tyVar "k") -:> kind)+    , primClass C.RowCons  (\kind -> tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRow (tyVar "k") -:> kindRow (tyVar "k") -:> kind)     ]  primRowListTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primRowListTypes =   M.fromList $-    [ (primSubName C.moduleRowList "RowList", (kindType -:> kindType, ExternData [Phantom]))-    , (primSubName C.moduleRowList "Cons", (tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRowList (tyVar "k") -:> kindRowList (tyVar "k"), ExternData [Phantom, Phantom, Phantom]))-    , (primSubName C.moduleRowList "Nil", (tyForall "k" kindType $ kindRowList (tyVar "k"), ExternData []))+    [ (C.RowList, (kindType -:> kindType, ExternData [Phantom]))+    , (C.RowListCons, (tyForall "k" kindType $ kindSymbol -:> tyVar "k" -:> kindRowList (tyVar "k") -:> kindRowList (tyVar "k"), ExternData [Phantom, Phantom, Phantom]))+    , (C.RowListNil, (tyForall "k" kindType $ kindRowList (tyVar "k"), ExternData []))     ] <> mconcat-    [ primClass (primSubName C.moduleRowList "RowToList")  (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRowList (tyVar "k") -:> kind)+    [ primClass C.RowToList  (\kind -> tyForall "k" kindType $ kindRow (tyVar "k") -:> kindRowList (tyVar "k") -:> kind)     ]  primSymbolTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primSymbolTypes =   M.fromList $ mconcat-    [ primClass (primSubName C.moduleSymbol "Append")  (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind)-    , primClass (primSubName C.moduleSymbol "Compare") (\kind -> kindSymbol -:> kindSymbol -:> kindOrdering -:> kind)-    , primClass (primSubName C.moduleSymbol "Cons")    (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind)+    [ primClass C.SymbolAppend  (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind)+    , primClass C.SymbolCompare (\kind -> kindSymbol -:> kindSymbol -:> kindOrdering -:> kind)+    , primClass C.SymbolCons    (\kind -> kindSymbol -:> kindSymbol -:> kindSymbol -:> kind)     ]  primIntTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primIntTypes =   M.fromList $ mconcat-    [ primClass (primSubName C.moduleInt "Add")     (\kind -> tyInt -:> tyInt -:> tyInt -:> kind)-    , primClass (primSubName C.moduleInt "Compare") (\kind -> tyInt -:> tyInt -:> kindOrdering -:> kind)-    , primClass (primSubName C.moduleInt "Mul")     (\kind -> tyInt -:> tyInt -:> tyInt -:> kind)-    , primClass (primSubName C.moduleInt "ToString") (\kind -> tyInt -:> kindSymbol -:> kind)+    [ primClass C.IntAdd      (\kind -> tyInt -:> tyInt -:> tyInt -:> kind)+    , primClass C.IntCompare  (\kind -> tyInt -:> tyInt -:> kindOrdering -:> kind)+    , primClass C.IntMul      (\kind -> tyInt -:> tyInt -:> tyInt -:> kind)+    , primClass C.IntToString (\kind -> tyInt -:> kindSymbol -:> kind)     ]  primTypeErrorTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind) primTypeErrorTypes =   M.fromList $-    [ (primSubName C.typeError "Doc", (kindType, ExternData []))-    , (primSubName C.typeError "Fail", (kindDoc -:> kindConstraint, ExternData [Nominal]))-    , (primSubName C.typeError "Warn", (kindDoc -:> kindConstraint, ExternData [Nominal]))-    , (primSubName C.typeError "Text", (kindSymbol -:> kindDoc, ExternData [Phantom]))-    , (primSubName C.typeError "Quote", (tyForall "k" kindType $ tyVar "k" -:> kindDoc, ExternData [Phantom]))-    , (primSubName C.typeError "QuoteLabel", (kindSymbol -:> kindDoc, ExternData [Phantom]))-    , (primSubName C.typeError "Beside", (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom]))-    , (primSubName C.typeError "Above", (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom]))+    [ (C.Doc, (kindType, ExternData []))+    , (C.Fail <&> coerceProperName, (kindDoc -:> kindConstraint, ExternData [Nominal]))+    , (C.Warn <&> coerceProperName, (kindDoc -:> kindConstraint, ExternData [Nominal]))+    , (C.Text, (kindSymbol -:> kindDoc, ExternData [Phantom]))+    , (C.Quote, (tyForall "k" kindType $ tyVar "k" -:> kindDoc, ExternData [Phantom]))+    , (C.QuoteLabel, (kindSymbol -:> kindDoc, ExternData [Phantom]))+    , (C.Beside, (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom]))+    , (C.Above, (kindDoc -:> kindDoc -:> kindDoc, ExternData [Phantom, Phantom]))     ] <> mconcat-    [ primClass (primSubName C.typeError "Fail") (\kind -> kindDoc -:> kind)-    , primClass (primSubName C.typeError "Warn") (\kind -> kindDoc -:> kind)+    [ primClass C.Fail (\kind -> kindDoc -:> kind)+    , primClass C.Warn (\kind -> kindDoc -:> kind)     ]  -- | The primitive class map. This just contains the `Partial` class.@@ -492,7 +474,7 @@ primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData primClasses =   M.fromList-    [ (primName "Partial", makeTypeClassData [] [] [] [] True)+    [ (C.Partial, makeTypeClassData [] [] [] [] True)     ]  -- | This contains all of the type classes from all Prim modules.@@ -511,7 +493,7 @@ primCoerceClasses =   M.fromList     -- class Coercible (a :: k) (b :: k)-    [ (primSubName C.moduleCoerce "Coercible", makeTypeClassData+    [ (C.Coercible, makeTypeClassData         [ ("a", Just (tyVar "k"))         , ("b", Just (tyVar "k"))         ] [] [] [] True)@@ -521,7 +503,7 @@ primRowClasses =   M.fromList     -- class Union (left :: Row k) (right :: Row k) (union :: Row k) | left right -> union, right union -> left, union left -> right-    [ (primSubName C.moduleRow "Union", makeTypeClassData+    [ (C.RowUnion, makeTypeClassData         [ ("left", Just (kindRow (tyVar "k")))         , ("right", Just (kindRow (tyVar "k")))         , ("union", Just (kindRow (tyVar "k")))@@ -532,7 +514,7 @@         ] True)      -- class Nub (original :: Row k) (nubbed :: Row k) | original -> nubbed-    , (primSubName C.moduleRow "Nub", makeTypeClassData+    , (C.RowNub, makeTypeClassData         [ ("original", Just (kindRow (tyVar "k")))         , ("nubbed", Just (kindRow (tyVar "k")))         ] [] []@@ -540,13 +522,13 @@         ] True)      -- class Lacks (label :: Symbol) (row :: Row k)-    , (primSubName C.moduleRow "Lacks", makeTypeClassData+    , (C.RowLacks, makeTypeClassData         [ ("label", Just kindSymbol)         , ("row", Just (kindRow (tyVar "k")))         ] [] [] [] True)      -- class RowCons (label :: Symbol) (a :: k) (tail :: Row k) (row :: Row k) | label tail a -> row, label row -> tail a-    , (primSubName C.moduleRow "Cons", makeTypeClassData+    , (C.RowCons, makeTypeClassData         [ ("label", Just kindSymbol)         , ("a", Just (tyVar "k"))         , ("tail", Just (kindRow (tyVar "k")))@@ -561,7 +543,7 @@ primRowListClasses =   M.fromList     -- class RowToList (row :: Row k) (list :: RowList k) | row -> list-    [ (primSubName C.moduleRowList "RowToList", makeTypeClassData+    [ (C.RowToList, makeTypeClassData         [ ("row", Just (kindRow (tyVar "k")))         , ("list", Just (kindRowList (tyVar "k")))         ] [] []@@ -573,7 +555,7 @@ primSymbolClasses =   M.fromList     -- class Append (left :: Symbol) (right :: Symbol) (appended :: Symbol) | left right -> appended, right appended -> left, appended left -> right-    [ (primSubName C.moduleSymbol "Append", makeTypeClassData+    [ (C.SymbolAppend, makeTypeClassData         [ ("left", Just kindSymbol)         , ("right", Just kindSymbol)         , ("appended", Just kindSymbol)@@ -584,7 +566,7 @@         ] True)      -- class Compare (left :: Symbol) (right :: Symbol) (ordering :: Ordering) | left right -> ordering-    , (primSubName C.moduleSymbol "Compare", makeTypeClassData+    , (C.SymbolCompare, makeTypeClassData         [ ("left", Just kindSymbol)         , ("right", Just kindSymbol)         , ("ordering", Just kindOrdering)@@ -593,7 +575,7 @@         ] True)      -- class Cons (head :: Symbol) (tail :: Symbol) (symbol :: Symbol) | head tail -> symbol, symbol -> head tail-    , (primSubName C.moduleSymbol "Cons", makeTypeClassData+    , (C.SymbolCons, makeTypeClassData         [ ("head", Just kindSymbol)         , ("tail", Just kindSymbol)         , ("symbol", Just kindSymbol)@@ -607,7 +589,7 @@ primIntClasses =   M.fromList     -- class Add (left :: Int) (right :: Int) (sum :: Int) | left right -> sum, left sum -> right, right sum -> left-    [ (primSubName C.moduleInt "Add", makeTypeClassData+    [ (C.IntAdd, makeTypeClassData         [ ("left", Just tyInt)         , ("right", Just tyInt)         , ("sum", Just tyInt)@@ -618,7 +600,7 @@         ] True)      -- class Compare (left :: Int) (right :: Int) (ordering :: Ordering) | left right -> ordering-    , (primSubName C.moduleInt "Compare", makeTypeClassData+    , (C.IntCompare, makeTypeClassData         [ ("left", Just tyInt)         , ("right", Just tyInt)         , ("ordering", Just kindOrdering)@@ -627,7 +609,7 @@         ] True)      -- class Mul (left :: Int) (right :: Int) (product :: Int) | left right -> product-    , (primSubName C.moduleInt "Mul", makeTypeClassData+    , (C.IntMul, makeTypeClassData         [ ("left", Just tyInt)         , ("right", Just tyInt)         , ("product", Just tyInt)@@ -636,7 +618,7 @@         ] True)      -- class ToString (int :: Int) (string :: Symbol) | int -> string-    , (primSubName C.moduleInt "ToString", makeTypeClassData+    , (C.IntToString, makeTypeClassData         [ ("int", Just tyInt)         , ("string", Just kindSymbol)         ] [] []@@ -648,11 +630,11 @@ primTypeErrorClasses =   M.fromList     -- class Fail (message :: Symbol)-    [ (primSubName C.typeError "Fail", makeTypeClassData+    [ (C.Fail, makeTypeClassData         [("message", Just kindDoc)] [] [] [] True)      -- class Warn (message :: Symbol)-    , (primSubName C.typeError "Warn", makeTypeClassData+    , (C.Warn, makeTypeClassData         [("message", Just kindDoc)] [] [] [] True)     ] 

@@ -4,6 +4,7 @@   ) where  import           Prelude+import           Protolude (unsnoc)  import           Control.Arrow ((&&&)) import           Control.Exception (displayException)@@ -34,12 +35,11 @@ import qualified GHC.Stack import           Language.PureScript.AST import qualified Language.PureScript.Bundle as Bundle-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C import           Language.PureScript.Crash import qualified Language.PureScript.CST.Errors as CST import qualified Language.PureScript.CST.Print as CST-import           Language.PureScript.Environment import           Language.PureScript.Label (Label(..)) import           Language.PureScript.Names import           Language.PureScript.Pretty@@ -79,7 +79,7 @@   | OrphanKindDeclaration (ProperName 'TypeName)   | OrphanRoleDeclaration (ProperName 'TypeName)   | RedefinedIdent Ident-  | OverlappingNamesInLet+  | OverlappingNamesInLet Ident   | UnknownName (Qualified Name)   | UnknownImport ModuleName Name   | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)@@ -195,7 +195,7 @@   | UnsupportedRoleDeclaration   | RoleDeclarationArityMismatch (ProperName 'TypeName) Int Int   | DuplicateRoleDeclaration (ProperName 'TypeName)-  | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName))+  | CannotDeriveInvalidConstructorArg (Qualified (ProperName 'ClassName)) [Qualified (ProperName 'ClassName)] Bool   deriving (Show)  data ErrorMessage = ErrorMessage@@ -258,7 +258,7 @@   OrphanKindDeclaration{} -> "OrphanKindDeclaration"   OrphanRoleDeclaration{} -> "OrphanRoleDeclaration"   RedefinedIdent{} -> "RedefinedIdent"-  OverlappingNamesInLet -> "OverlappingNamesInLet"+  OverlappingNamesInLet{} -> "OverlappingNamesInLet"   UnknownName{} -> "UnknownName"   UnknownImport{} -> "UnknownImport"   UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"@@ -588,6 +588,13 @@         , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset         ] +commasAndConjunction :: Text -> [Text] -> Text+commasAndConjunction conj = \case+  [x] -> x+  [x, y] -> x <> " " <> conj <> " " <> y+  (unsnoc -> Just (rest, z)) -> foldMap (<> ", ") rest <> conj <> " " <> z+  _ -> ""+ -- | Default color intensity and color for code defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color) defaultCodeColor = (ANSI.Dull, ANSI.Yellow)@@ -731,8 +738,8 @@       line "The last statement in a 'do' block must be an expression, but this block ends with a binder."     renderSimpleErrorMessage InvalidDoLet =       line "The last statement in a 'do' block must be an expression, but this block ends with a let binding."-    renderSimpleErrorMessage OverlappingNamesInLet =-      line "The same name was used more than once in a let binding."+    renderSimpleErrorMessage (OverlappingNamesInLet name) =+      line $ "The name " <> markCode (showIdent name) <> " was defined multiple times in a binding group"     renderSimpleErrorMessage (InfiniteType ty) =       paras [ line "An infinite type was inferred for an expression: "             , markCodeBox $ indent $ prettyType ty@@ -753,10 +760,10 @@       line $ "The role declaration for " <> markCode (runProperName nm) <> " should follow its definition."     renderSimpleErrorMessage (RedefinedIdent name) =       line $ "The value " <> markCode (showIdent name) <> " has been defined multiple times"-    renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident i)))) | i `elem` [ C.bind, C.discard ] =+    renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident i)))) | i `elem` [ C.S_bind, C.S_discard ] =       line $ "Unknown " <> printName name <> ". You're probably using do-notation, which the compiler replaces with calls to the " <> markCode "bind" <> " and " <> markCode "discard" <> " functions. Please import " <> markCode i <> " from module " <> markCode "Prelude"-    renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident i)))) | i == C.negate =-      line $ "Unknown " <> printName name <> ". You're probably using numeric negation (the unary " <> markCode "-" <> " operator), which the compiler replaces with calls to the " <> markCode i <> " function. Please import " <> markCode i <> " from module " <> markCode "Prelude"+    renderSimpleErrorMessage (UnknownName name@(Qualified (BySourcePos _) (IdentName (Ident C.S_negate)))) =+      line $ "Unknown " <> printName name <> ". You're probably using numeric negation (the unary " <> markCode "-" <> " operator), which the compiler replaces with calls to the " <> markCode C.S_negate <> " function. Please import " <> markCode C.S_negate <> " from module " <> markCode "Prelude"     renderSimpleErrorMessage (UnknownName name) =       line $ "Unknown " <> printName name     renderSimpleErrorMessage (UnknownImport mn name) =@@ -884,7 +891,7 @@             , line "because the class was not in scope. Perhaps it was not exported."             ]     renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Fail _ [ ty ] _) _ _) | Just box <- toTypelevelString ty =-      paras [ line "A custom type error occurred while solving type class constraints:"+      paras [ line "Custom error:"             , indent box             ]     renderSimpleErrorMessage (NoInstanceFound (Constraint _ C.Partial@@ -1026,7 +1033,7 @@     renderSimpleErrorMessage (ExtraneousClassMember ident className) =       line $ "" <> markCode (showIdent ident) <> " is not a member of type class " <> markCode (showQualified runProperName className)     renderSimpleErrorMessage (ExpectedType ty kind) =-      paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode C.typ <> "."+      paras [ line $ "In a type-annotated expression " <> markCode "x :: t" <> ", the type " <> markCode "t" <> " must have kind " <> markCode (runProperName . disqualify $ C.Type) <> "."             , line "The error arises from the type"             , markCodeBox $ indent $ prettyType ty             , line "having the kind"@@ -1379,11 +1386,12 @@     renderSimpleErrorMessage (DuplicateRoleDeclaration name) =       line $ "Duplicate role declaration for " <> markCode (runProperName name) <> "." -    renderSimpleErrorMessage (CannotDeriveInvalidConstructorArg className) =+    renderSimpleErrorMessage (CannotDeriveInvalidConstructorArg className relatedClasses checkVariance) =       paras         [ line $ "One or more type variables are in positions that prevent " <> markCode (runProperName $ disqualify className) <> " from being derived."         , line $ "To derive this class, make sure that these variables are only used as the final arguments to type constructors, "-          <> "and that those type constructors themselves have instances of " <> markCode (runProperName $ disqualify className) <> "."+          <> (if checkVariance then "that their variance matches the variance of " <> markCode (runProperName $ disqualify className) <> ", " else "")+          <> "and that those type constructors themselves have instances of " <> commasAndConjunction "or" (markCode . showQualified runProperName <$> relatedClasses) <> "."         ]      renderHint :: ErrorMessageHint -> Box.Box -> Box.Box@@ -1941,18 +1949,16 @@ toTypelevelString :: Type a -> Maybe Box.Box toTypelevelString (TypeLevelString _ s) =   Just . Box.text $ decodeStringWithReplacement s-toTypelevelString (TypeApp _ (TypeConstructor _ f) x)-  | f == primSubName C.typeError "Text" = toTypelevelString x-toTypelevelString (TypeApp _ (KindApp _ (TypeConstructor _ f) _) x)-  | f == primSubName C.typeError "Quote" = Just (typeAsBox maxBound x)-toTypelevelString (TypeApp _ (TypeConstructor _ f) (TypeLevelString _ x))-  | f == primSubName C.typeError "QuoteLabel" = Just . line . prettyPrintLabel . Label $ x-toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ f) x) ret)-  | f == primSubName C.typeError "Beside" =-    (Box.<>) <$> toTypelevelString x <*> toTypelevelString ret-toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ f) x) ret)-  | f == primSubName C.typeError "Above" =-    (Box.//) <$> toTypelevelString x <*> toTypelevelString ret+toTypelevelString (TypeApp _ (TypeConstructor _ C.Text) x) =+  toTypelevelString x+toTypelevelString (TypeApp _ (KindApp _ (TypeConstructor _ C.Quote) _) x) =+  Just (typeAsBox maxBound x)+toTypelevelString (TypeApp _ (TypeConstructor _ C.QuoteLabel) (TypeLevelString _ x)) =+  Just . line . prettyPrintLabel . Label $ x+toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ C.Beside) x) ret) =+  (Box.<>) <$> toTypelevelString x <*> toTypelevelString ret+toTypelevelString (TypeApp _ (TypeApp _ (TypeConstructor _ C.Above) x) ret) =+  (Box.//) <$> toTypelevelString x <*> toTypelevelString ret toTypelevelString _ = Nothing  -- | Rethrow an error with a more detailed error message in the case of failure

@@ -30,7 +30,8 @@ import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Externs import           Language.PureScript.Ide.Filter-import           Language.PureScript.Ide.Imports    hiding (Import)+import           Language.PureScript.Ide.Imports hiding (Import)+import           Language.PureScript.Ide.Imports.Actions import           Language.PureScript.Ide.Matcher import           Language.PureScript.Ide.Prim import           Language.PureScript.Ide.Rebuild

@@ -91,8 +91,8 @@ prettyCtor :: WildcardAnnotations -> Constructor -> Text prettyCtor _ (ctorName, []) = P.runProperName ctorName prettyCtor wsa (ctorName, ctorArgs) =-  "("<> P.runProperName ctorName <> " "-  <> T.unwords (map (prettyPrintWildcard wsa) ctorArgs) <>")"+  "(" <> P.runProperName ctorName <> " "+  <> T.unwords (map (prettyPrintWildcard wsa) ctorArgs) <> ")"  prettyPrintWildcard :: WildcardAnnotations -> P.Type a -> Text prettyPrintWildcard (WildcardAnnotations True) = prettyWildcard

@@ -89,7 +89,7 @@   where     go (Match (moduleName, d@(IdeDeclarationAnn ann decl))) =       let-        origin = fromMaybe moduleName (ann^.annExportedFrom)+        origin = fromMaybe moduleName (ann ^. annExportedFrom)       in         Map.alter         (insertDeclaration moduleName origin d)

@@ -90,7 +90,7 @@ textError (GeneralError msg)          = msg textError (NotFound ident)            = "Symbol '" <> ident <> "' not found." textError (ModuleNotFound ident)      = "Module '" <> ident <> "' not found."-textError (ModuleFileNotFound ident)  = "Extern file for module " <> ident <>" could not be found"+textError (ModuleFileNotFound ident)  = "Extern file for module " <> ident <> " could not be found" textError (RebuildError _ err)        = show err  prettyPrintTypeSingleLine :: P.Type a -> Text

@@ -69,14 +69,14 @@           Nothing ->             acc           Just tyDecl -> IdeDeclTypeClass-            (IdeTypeClass tcn (tyDecl^.ideTypeKind) [])+            (IdeTypeClass tcn (tyDecl ^. ideTypeKind) [])             : filter (not . anyOf (_IdeDeclType . ideTypeName) (== P.coerceProperName tcn)) acc       SynonymToResolve tn ty ->         case findType tn acc of           Nothing ->             acc           Just tyDecl ->-            IdeDeclTypeSynonym (IdeTypeSynonym tn ty (tyDecl^.ideTypeKind))+            IdeDeclTypeSynonym (IdeTypeSynonym tn ty (tyDecl ^. ideTypeKind))             : filter (not . anyOf (_IdeDeclType . ideTypeName) (== tn)) acc  findType :: P.ProperName 'P.TypeName -> [IdeDeclaration] -> Maybe IdeType@@ -103,14 +103,14 @@   -- because those are typechecker internal definitions that shouldn't   -- be user facing   P.EDType{..} -> Right do-    guard (isNothing (Text.find (== '$') (edTypeName^.properNameT)))+    guard (isNothing (Text.find (== '$') (edTypeName ^. properNameT)))     Just (IdeDeclType (IdeType edTypeName edTypeKind []))   P.EDTypeSynonym{..} ->-    if isNothing (Text.find (== '$') (edTypeSynonymName^.properNameT))+    if isNothing (Text.find (== '$') (edTypeSynonymName ^. properNameT))       then Left (SynonymToResolve edTypeSynonymName edTypeSynonymType)       else Right Nothing   P.EDDataConstructor{..} -> Right do-    guard (isNothing (Text.find (== '$') (edDataCtorName^.properNameT)))+    guard (isNothing (Text.find (== '$') (edDataCtorName ^. properNameT)))     Just       (IdeDeclDataConstructor         (IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType))

@@ -19,6 +19,7 @@        , exactFilter        , prefixFilter        , declarationTypeFilter+       , dependencyFilter        , applyFilters        ) where @@ -31,9 +32,14 @@ import qualified Data.Map as Map import           Language.PureScript.Ide.Filter.Declaration (DeclarationType) import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Imports import           Language.PureScript.Ide.Util+ import qualified Language.PureScript           as P+import qualified Data.Text as T +import Language.PureScript.Ide.Filter.Imports + newtype Filter = Filter (Either (Set P.ModuleName) DeclarationFilter)   deriving Show @@ -45,6 +51,7 @@   | Exact Text   | Namespace (Set IdeNamespace)   | DeclType (Set DeclarationType)+  | Dependencies { qualifier :: Maybe P.ModuleName, currentModuleName :: P.ModuleName, dependencyImports :: [Import] }   deriving Show  -- | Only keeps Declarations in the given modules@@ -67,6 +74,9 @@ declarationTypeFilter :: Set DeclarationType -> Filter declarationTypeFilter dts = Filter (Right (DeclType dts)) +dependencyFilter :: Maybe P.ModuleName -> P.ModuleName -> [Import] -> Filter+dependencyFilter q m f = Filter (Right (Dependencies q m f))+ optimizeFilters :: [Filter] -> (Maybe (Set P.ModuleName), [DeclarationFilter]) optimizeFilters = first smashModuleFilters . partitionEithers . map unFilter   where@@ -88,17 +98,19 @@   -> ModuleMap [IdeDeclarationAnn] applyDeclarationFilters fs =   Map.filter (not . null)-  . Map.map (foldr (.) identity (map applyDeclarationFilter fs))+  . Map.mapWithKey (\modl decls -> foldr (.) identity (map (applyDeclarationFilter modl) fs) decls)  applyDeclarationFilter-  :: DeclarationFilter+  :: P.ModuleName+  -> DeclarationFilter   -> [IdeDeclarationAnn]   -> [IdeDeclarationAnn]-applyDeclarationFilter f = case f of+applyDeclarationFilter modl f = case f of   Prefix prefix -> prefixFilter' prefix   Exact t -> exactFilter' t   Namespace namespaces -> namespaceFilter' namespaces   DeclType dts -> declarationTypeFilter' dts+  Dependencies qual currentModuleName imps -> dependencyFilter' modl qual currentModuleName imps  namespaceFilter' :: Set IdeNamespace -> [IdeDeclarationAnn] -> [IdeDeclarationAnn] namespaceFilter' namespaces =@@ -116,6 +128,13 @@ declarationTypeFilter' declTypes =   filter (\decl -> declarationType (discardAnn decl) `Set.member` declTypes) +dependencyFilter' :: P.ModuleName -> Maybe P.ModuleName -> P.ModuleName -> [Import] -> [IdeDeclarationAnn] -> [IdeDeclarationAnn]+dependencyFilter' modl qual currentModuleName imports =+  if modl == currentModuleName && isNothing qual then+    identity+  else+    filter (\decl -> any (matchImport qual modl decl) imports)+ instance FromJSON Filter where   parseJSON = withObject "filter" $ \o -> do     (filter' :: Text) <- o .: "filter"@@ -129,7 +148,7 @@         search <- params .: "search"         pure (exactFilter search)       "prefix" -> do-        params <- o.: "params"+        params <- o .: "params"         search <- params .: "search"         pure (prefixFilter search)       "namespace" -> do@@ -137,6 +156,13 @@         namespaces <- params .: "namespaces"         pure (namespaceFilter (Set.fromList namespaces))       "declarations" -> do-        declarations <- o.: "params"+        declarations <- o .: "params"         pure (declarationTypeFilter (Set.fromList declarations))+      "dependencies" -> do+        params <- o .: "params"+        moduleText <- params .: "moduleText"+        qualifier <- fmap P.moduleNameFromString <$> params .:? "qualifier"+        case sliceImportSection (T.lines moduleText) of+          Left err -> fail ("Couldn't parse module imports: " <> T.unpack err)+          Right (currentModuleName, _, imports, _ ) -> pure (dependencyFilter qualifier currentModuleName imports)       s -> fail ("Unknown filter: " <> show s)

@@ -0,0 +1,31 @@+module Language.PureScript.Ide.Filter.Imports where+++import           Protolude                     hiding (isPrefixOf)++import Language.PureScript.Ide.Types+import Language.PureScript.Ide.Imports++import qualified Language.PureScript as P++matchImport :: Maybe P.ModuleName -> P.ModuleName -> IdeDeclarationAnn -> Import -> Bool+matchImport matchQualifier declMod (IdeDeclarationAnn _ decl) (Import importMod declTy qualifier) | declMod == importMod && matchQualifier == qualifier =+  case declTy of +    P.Implicit -> True+    P.Explicit refs -> any (matchRef decl) refs+    P.Hiding refs -> not $ any (matchRef decl) refs+  where+    matchRef (IdeDeclValue (IdeValue ident _)) (P.ValueRef _ ident') = ident == ident'+    matchRef (IdeDeclType (IdeType tname _kind _dctors)) (P.TypeRef _ tname' _dctors') = tname == tname'+    matchRef (IdeDeclTypeSynonym (IdeTypeSynonym tname _type _kind)) (P.TypeRef _ tname' _dctors) = tname == tname' -- Can this occur?+    +    matchRef (IdeDeclDataConstructor (IdeDataConstructor dcname tname _type)) (P.TypeRef _ tname' dctors) =+      tname == tname'+      && maybe True (dcname `elem`) dctors -- (..) or explicitly lists constructor+      +    matchRef (IdeDeclTypeClass (IdeTypeClass tcname _kind _instances)) (P.TypeClassRef _ tcname') = tcname == tcname'+    matchRef (IdeDeclValueOperator (IdeValueOperator{ _ideValueOpName })) (P.ValueOpRef _ opname) = _ideValueOpName == opname+    matchRef (IdeDeclTypeOperator (IdeTypeOperator{ _ideTypeOpName })) (P.TypeOpRef _ opname) = _ideTypeOpName == opname+    matchRef _ _ = False++matchImport _ _ _ _ = False

@@ -13,17 +13,11 @@ -----------------------------------------------------------------------------  module Language.PureScript.Ide.Imports-       ( addImplicitImport-       , addQualifiedImport-       , addImportForIdentifier-       , answerRequest-       , parseImportsFromFile+       ( parseImportsFromFile+       , parseImportsFromFile'          -- for tests        , parseImport        , prettyPrintImportSection-       , addImplicitImport'-       , addQualifiedImport'-       , addExplicitImport'        , sliceImportSection        , prettyPrintImport'        , Import(Import)@@ -32,22 +26,14 @@  import           Protolude hiding (moduleName) -import           Control.Lens                       ((^.), (%~), ix, has)-import           Data.List                          (nubBy, partition)+import           Control.Lens                       ((^.), (%~), ix)+import           Data.List                          (partition) import qualified Data.List.NonEmpty                 as NE-import qualified Data.Map                           as Map import qualified Data.Text                          as T import qualified Language.PureScript                as P-import qualified Language.PureScript.Constants.Prim as C import qualified Language.PureScript.CST            as CST-import           Language.PureScript.Ide.Completion import           Language.PureScript.Ide.Error-import           Language.PureScript.Ide.Filter-import           Language.PureScript.Ide.State-import           Language.PureScript.Ide.Prim-import           Language.PureScript.Ide.Types import           Language.PureScript.Ide.Util-import           System.IO.UTF8                     (writeUTF8FileT)  data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)               deriving (Eq, Show)@@ -136,201 +122,6 @@       & ix 0 %~ T.drop (c1 - 1)       & ix (l2 - l1) %~ T.take c2 --- | Adds an implicit import like @import Prelude@ to a Sourcefile.-addImplicitImport-  :: (MonadIO m, MonadError IdeError m)-  => FilePath     -- ^ The source file read from-  -> P.ModuleName -- ^ The module to import-  -> m [Text]-addImplicitImport fp mn = do-  (_, pre, imports, post) <- parseImportsFromFile' fp-  let newImportSection = addImplicitImport' imports mn-  pure $ joinSections (pre, newImportSection, post)--addImplicitImport' :: [Import] -> P.ModuleName -> [Text]-addImplicitImport' imports mn =-  prettyPrintImportSection (Import mn P.Implicit Nothing : imports)---- | Adds a qualified import like @import Data.Map as Map@ to a source file.-addQualifiedImport-  :: (MonadIO m, MonadError IdeError m)-  => FilePath-  -- ^ The sourcefile read from-  -> P.ModuleName-  -- ^ The module to import-  -> P.ModuleName-  -- ^ The qualifier under which to import-  -> m [Text]-addQualifiedImport fp mn qualifier = do-  (_, pre, imports, post) <- parseImportsFromFile' fp-  let newImportSection = addQualifiedImport' imports mn qualifier-  pure $ joinSections (pre, newImportSection, post)--addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text]-addQualifiedImport' imports mn qualifier =-  prettyPrintImportSection (Import mn P.Implicit (Just qualifier) : imports)---- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an--- explicit import already exists for the given module, it adds the identifier--- to that imports list.------ So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing--- @import Prelude (bind)@ in the file File.purs returns @["import Prelude--- (bind, unit)"]@-addExplicitImport :: (MonadIO m, MonadError IdeError m) =>-                     FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text]-addExplicitImport fp decl moduleName qualifier = do-  (mn, pre, imports, post) <- parseImportsFromFile' fp-  let newImportSection =-        -- TODO: Open an issue when this PR is merged, we should optimise this-        -- so that this case does not write to disc-        if mn == moduleName-        then imports-        else addExplicitImport' decl moduleName qualifier imports-  pure $ joinSections (pre, prettyPrintImportSection newImportSection, post)--addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import]-addExplicitImport' decl moduleName qualifier imports =-  let-    isImplicitlyImported =-        any (\case-          Import mn P.Implicit qualifier' -> mn == moduleName && qualifier == qualifier'-          _ -> False) imports-    isNotExplicitlyImportedFromPrim =-      moduleName == C.Prim &&-        not (any (\case-          Import C.Prim (P.Explicit _) Nothing -> True-          _ -> False) imports)-    -- We can't import Modules from other modules-    isModule = has _IdeDeclModule decl--    matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier'-    matches _ = False-    freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier-  in-    if isImplicitlyImported || isNotExplicitlyImportedFromPrim || isModule-    then imports-    else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports-  where-    refFromDeclaration (IdeDeclTypeClass tc) =-      P.TypeClassRef ideSpan (tc ^. ideTCName)-    refFromDeclaration (IdeDeclDataConstructor dtor) =-      P.TypeRef ideSpan (dtor ^. ideDtorTypeName) Nothing-    refFromDeclaration (IdeDeclType t) =-      P.TypeRef ideSpan (t ^. ideTypeName) (Just [])-    refFromDeclaration (IdeDeclValueOperator op) =-      P.ValueOpRef ideSpan (op ^. ideValueOpName)-    refFromDeclaration (IdeDeclTypeOperator op) =-      P.TypeOpRef ideSpan (op ^. ideTypeOpName)-    refFromDeclaration d =-      P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d))--    -- | Adds a declaration to an import:-    -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)-    insertDeclIntoImport :: IdeDeclaration -> Import -> Import-    insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) =-      Import mn (P.Explicit (sort (insertDeclIntoRefs decl' refs))) qual-    insertDeclIntoImport _ is = is--    insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]-    insertDeclIntoRefs d@(IdeDeclDataConstructor dtor) refs =-      updateAtFirstOrPrepend-        (matchType (dtor ^. ideDtorTypeName))-        (insertDtor (dtor ^. ideDtorName))-        (refFromDeclaration d)-        refs-    insertDeclIntoRefs (IdeDeclType t) refs-      | any matches refs = refs-      where-        matches (P.TypeRef _ typeName _) = _ideTypeName t == typeName-        matches _ = False-    insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)--    insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing-    insertDtor _ refs = refs--    matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool-    matchType tn (P.TypeRef _ n _) = tn == n-    matchType _ _ = False--ideSpan :: P.SourceSpan-ideSpan = P.internalModuleSourceSpan "<psc-ide>"---- | If none of the elements of the list satisfy the given predicate 'predicate', then prepend the default value 'def'--- to the given list. Otherwise, update the first element of the list that satisfies 'predicate' with the updating--- function 'update'.-updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a]-updateAtFirstOrPrepend predicate update def xs =-  case break predicate xs of-    (before, []) -> def : before-    (before, x : after) -> before ++ [update x] ++ after---- | Looks up the given identifier in the currently loaded modules.------ * Throws an error if the identifier cannot be found.------ * If exactly one match is found, adds an explicit import to the importsection------ * If more than one possible imports are found, reports the possibilities as a--- list of completions.-addImportForIdentifier-  :: (Ide m, MonadError IdeError m)-  => FilePath -- ^ The Sourcefile to read from-  -> Text     -- ^ The identifier to import-  -> Maybe P.ModuleName  -- ^ The optional qualifier under which to import-  -> [Filter] -- ^ Filters to apply before searching for the identifier-  -> m (Either [Match IdeDeclaration] [Text])-addImportForIdentifier fp ident qual filters = do-  let addPrim = Map.union idePrimDeclarations-  modules <- getAllModules Nothing-  let-    matches =-      getExactMatches ident filters (addPrim modules)-        & map (fmap discardAnn)-        & filter (\(Match (_, d)) -> not (has _IdeDeclModule d))--  case matches of-    [] ->-      throwError (NotFound "Couldn't find the given identifier. \-                           \Have you loaded the corresponding module?")--    -- Only one match was found for the given identifier, so we can insert it-    -- right away-    [Match (m, decl)] ->-      Right <$> addExplicitImport fp decl m qual--    -- This case comes up for newtypes and dataconstructors. Because values and-    -- types don't share a namespace we can get multiple matches from the same-    -- module. This also happens for parameterized types, as these generate both-    -- a type as well as a type synonym.--    ms@[Match (m1, d1), Match (m2, d2)] ->-      if m1 /= m2-         -- If the modules don't line up we just ask the user to specify the-         -- module-      then pure (Left ms)-      else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of-        -- If dataconstructor and type line up we just import the-        -- dataconstructor as that will give us an unnecessary import warning at-        -- worst-        Just decl ->-          Right <$> addExplicitImport fp decl m1 qual-        -- Here we need the user to specify whether they wanted a -        -- dataconstructor or a type-        Nothing ->-          throwError (GeneralError "Undecidable between type and dataconstructor")--    -- Multiple matches were found so we need to ask the user to clarify which-    -- module they meant-    xs ->-      pure (Left xs)-    where-      decideRedundantCase d@(IdeDeclDataConstructor dtor) (IdeDeclType t) =-        if dtor ^. ideDtorTypeName == t ^. ideTypeName then Just d else Nothing-      decideRedundantCase IdeDeclType{} ts@IdeDeclTypeSynonym{} =-        Just ts-      decideRedundantCase _ _ = Nothing- prettyPrintImport' :: Import -> Text prettyPrintImport' (Import mn idt qual) =   "import " <> P.prettyPrintImport mn idt qual@@ -352,18 +143,6 @@       Import _ (P.Hiding _) Nothing -> True       _ -> False ---- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@,--- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the--- first argument.-answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success-answerRequest outfp rs  =-  case outfp of-    Nothing -> pure (MultilineTextResult rs)-    Just outfp' -> do-      liftIO (writeUTF8FileT outfp' (T.unlines rs))-      pure (TextResult ("Written to " <> T.pack outfp'))- -- | Test and ghci helper parseImport :: Text -> Maybe Import parseImport t =@@ -373,15 +152,3 @@     Right (_, mn, idt, mmn) ->       Just (Import mn idt mmn)     _ -> Nothing--joinSections :: ([Text], [Text], [Text]) -> [Text]-joinSections (pre, decls, post) = pre `joinLine` (decls `joinLine` post)-  where-  isBlank = T.all (== ' ')-  joinLine as bs-    | Just ln1 <- lastMay as-    , Just ln2 <- head bs-    , not (isBlank ln1) && not (isBlank ln2) =-        as ++ [""] ++ bs-    | otherwise =-        as ++ bs

@@ -0,0 +1,251 @@+module Language.PureScript.Ide.Imports.Actions +       ( addImplicitImport+       , addQualifiedImport+       , addImportForIdentifier+       , answerRequest++        -- for tests+       , addImplicitImport'+       , addQualifiedImport'+       , addExplicitImport'+       )+where++import           Protolude hiding (moduleName)++import           Control.Lens                       ((^.), has)+import           Data.List                          (nubBy)+import qualified Data.Map                           as Map+import qualified Data.Text                          as T+import qualified Language.PureScript                as P+import qualified Language.PureScript.Constants.Prim as C+import           Language.PureScript.Ide.Completion+import           Language.PureScript.Ide.Error+import           Language.PureScript.Ide.Filter+import           Language.PureScript.Ide.Imports+import           Language.PureScript.Ide.State+import           Language.PureScript.Ide.Prim+import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Util+import           System.IO.UTF8                     (writeUTF8FileT)++-- | Adds an implicit import like @import Prelude@ to a Sourcefile.+addImplicitImport+  :: (MonadIO m, MonadError IdeError m)+  => FilePath     -- ^ The source file read from+  -> P.ModuleName -- ^ The module to import+  -> m [Text]+addImplicitImport fp mn = do+  (_, pre, imports, post) <- parseImportsFromFile' fp+  let newImportSection = addImplicitImport' imports mn+  pure $ joinSections (pre, newImportSection, post)++addImplicitImport' :: [Import] -> P.ModuleName -> [Text]+addImplicitImport' imports mn =+  prettyPrintImportSection (Import mn P.Implicit Nothing : imports)++-- | Adds a qualified import like @import Data.Map as Map@ to a source file.+addQualifiedImport+  :: (MonadIO m, MonadError IdeError m)+  => FilePath+  -- ^ The sourcefile read from+  -> P.ModuleName+  -- ^ The module to import+  -> P.ModuleName+  -- ^ The qualifier under which to import+  -> m [Text]+addQualifiedImport fp mn qualifier = do+  (_, pre, imports, post) <- parseImportsFromFile' fp+  let newImportSection = addQualifiedImport' imports mn qualifier+  pure $ joinSections (pre, newImportSection, post)++addQualifiedImport' :: [Import] -> P.ModuleName -> P.ModuleName -> [Text]+addQualifiedImport' imports mn qualifier =+  prettyPrintImportSection (Import mn P.Implicit (Just qualifier) : imports)++-- | Adds an explicit import like @import Prelude (unit)@ to a Sourcefile. If an+-- explicit import already exists for the given module, it adds the identifier+-- to that imports list.+--+-- So @addExplicitImport "/File.purs" "bind" "Prelude"@ with an already existing+-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude+-- (bind, unit)"]@+addExplicitImport :: (MonadIO m, MonadError IdeError m) =>+                     FilePath -> IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> m [Text]+addExplicitImport fp decl moduleName qualifier = do+  (mn, pre, imports, post) <- parseImportsFromFile' fp+  let newImportSection =+        -- TODO: Open an issue when this PR is merged, we should optimise this+        -- so that this case does not write to disc+        if mn == moduleName+        then imports+        else addExplicitImport' decl moduleName qualifier imports+  pure $ joinSections (pre, prettyPrintImportSection newImportSection, post)++addExplicitImport' :: IdeDeclaration -> P.ModuleName -> Maybe P.ModuleName -> [Import] -> [Import]+addExplicitImport' decl moduleName qualifier imports =+  let+    isImplicitlyImported =+        any (\case+          Import mn P.Implicit qualifier' -> mn == moduleName && qualifier == qualifier'+          _ -> False) imports+    isNotExplicitlyImportedFromPrim =+      moduleName == C.M_Prim &&+        not (any (\case+          Import C.M_Prim (P.Explicit _) Nothing -> True+          _ -> False) imports)+    -- We can't import Modules from other modules+    isModule = has _IdeDeclModule decl++    matches (Import mn (P.Explicit _) qualifier') = mn == moduleName && qualifier == qualifier'+    matches _ = False+    freshImport = Import moduleName (P.Explicit [refFromDeclaration decl]) qualifier+  in+    if isImplicitlyImported || isNotExplicitlyImportedFromPrim || isModule+    then imports+    else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports+  where+    refFromDeclaration (IdeDeclTypeClass tc) =+      P.TypeClassRef ideSpan (tc ^. ideTCName)+    refFromDeclaration (IdeDeclDataConstructor dtor) =+      P.TypeRef ideSpan (dtor ^. ideDtorTypeName) Nothing+    refFromDeclaration (IdeDeclType t) =+      P.TypeRef ideSpan (t ^. ideTypeName) (Just [])+    refFromDeclaration (IdeDeclValueOperator op) =+      P.ValueOpRef ideSpan (op ^. ideValueOpName)+    refFromDeclaration (IdeDeclTypeOperator op) =+      P.TypeOpRef ideSpan (op ^. ideTypeOpName)+    refFromDeclaration d =+      P.ValueRef ideSpan (P.Ident (identifierFromIdeDeclaration d))++    -- | Adds a declaration to an import:+    -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)+    insertDeclIntoImport :: IdeDeclaration -> Import -> Import+    insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) =+      Import mn (P.Explicit (sort (insertDeclIntoRefs decl' refs))) qual+    insertDeclIntoImport _ is = is++    insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]+    insertDeclIntoRefs d@(IdeDeclDataConstructor dtor) refs =+      updateAtFirstOrPrepend+        (matchType (dtor ^. ideDtorTypeName))+        (insertDtor (dtor ^. ideDtorName))+        (refFromDeclaration d)+        refs+    insertDeclIntoRefs (IdeDeclType t) refs+      | any matches refs = refs+      where+        matches (P.TypeRef _ typeName _) = _ideTypeName t == typeName+        matches _ = False+    insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)++    insertDtor _ (P.TypeRef ss tn' _) = P.TypeRef ss tn' Nothing+    insertDtor _ refs = refs++    matchType :: P.ProperName 'P.TypeName -> P.DeclarationRef -> Bool+    matchType tn (P.TypeRef _ n _) = tn == n+    matchType _ _ = False+++-- | Looks up the given identifier in the currently loaded modules.+--+-- * Throws an error if the identifier cannot be found.+--+-- * If exactly one match is found, adds an explicit import to the importsection+--+-- * If more than one possible imports are found, reports the possibilities as a+-- list of completions.+addImportForIdentifier+  :: (Ide m, MonadError IdeError m)+  => FilePath -- ^ The Sourcefile to read from+  -> Text     -- ^ The identifier to import+  -> Maybe P.ModuleName  -- ^ The optional qualifier under which to import+  -> [Filter] -- ^ Filters to apply before searching for the identifier+  -> m (Either [Match IdeDeclaration] [Text])+addImportForIdentifier fp ident qual filters = do+  let addPrim = Map.union idePrimDeclarations+  modules <- getAllModules Nothing+  let+    matches =+      getExactMatches ident filters (addPrim modules)+        & map (fmap discardAnn)+        & filter (\(Match (_, d)) -> not (has _IdeDeclModule d))++  case matches of+    [] ->+      throwError (NotFound "Couldn't find the given identifier. \+                           \Have you loaded the corresponding module?")++    -- Only one match was found for the given identifier, so we can insert it+    -- right away+    [Match (m, decl)] ->+      Right <$> addExplicitImport fp decl m qual++    -- This case comes up for newtypes and dataconstructors. Because values and+    -- types don't share a namespace we can get multiple matches from the same+    -- module. This also happens for parameterized types, as these generate both+    -- a type as well as a type synonym.++    ms@[Match (m1, d1), Match (m2, d2)] ->+      if m1 /= m2+         -- If the modules don't line up we just ask the user to specify the+         -- module+      then pure (Left ms)+      else case decideRedundantCase d1 d2 <|> decideRedundantCase d2 d1 of+        -- If dataconstructor and type line up we just import the+        -- dataconstructor as that will give us an unnecessary import warning at+        -- worst+        Just decl ->+          Right <$> addExplicitImport fp decl m1 qual+        -- Here we need the user to specify whether they wanted a +        -- dataconstructor or a type+        Nothing ->+          throwError (GeneralError "Undecidable between type and dataconstructor")++    -- Multiple matches were found so we need to ask the user to clarify which+    -- module they meant+    xs ->+      pure (Left xs)+    where+      decideRedundantCase d@(IdeDeclDataConstructor dtor) (IdeDeclType t) =+        if dtor ^. ideDtorTypeName == t ^. ideTypeName then Just d else Nothing+      decideRedundantCase IdeDeclType{} ts@IdeDeclTypeSynonym{} =+        Just ts+      decideRedundantCase _ _ = Nothing++-- | Writes a list of lines to @Just filepath@ and responds with a @TextResult@,+-- or returns the lines as a @MultilineTextResult@ if @Nothing@ was given as the+-- first argument.+answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success+answerRequest outfp rs  =+  case outfp of+    Nothing -> pure (MultilineTextResult rs)+    Just outfp' -> do+      liftIO (writeUTF8FileT outfp' (T.unlines rs))+      pure (TextResult ("Written to " <> T.pack outfp'))+++-- | If none of the elements of the list satisfy the given predicate 'predicate', then prepend the default value 'def'+-- to the given list. Otherwise, update the first element of the list that satisfies 'predicate' with the updating+-- function 'update'.+updateAtFirstOrPrepend :: (a -> Bool) -> (a -> a) -> a -> [a] -> [a]+updateAtFirstOrPrepend predicate update def xs =+  case break predicate xs of+    (before, []) -> def : before+    (before, x : after) -> before ++ [update x] ++ after+++ideSpan :: P.SourceSpan+ideSpan = P.internalModuleSourceSpan "<psc-ide>"++joinSections :: ([Text], [Text], [Text]) -> [Text]+joinSections (pre, decls, post) = pre `joinLine` (decls `joinLine` post)+  where+  isBlank = T.all (== ' ')+  joinLine as bs+    | Just ln1 <- lastMay as+    , Just ln2 <- head bs+    , not (isBlank ln1) && not (isBlank ln2) =+        as ++ [""] ++ bs+    | otherwise =+        as ++ bs

@@ -94,7 +94,7 @@ -- Borrowed from: http://cdewaka.com/2013/06/fuzzy-pattern-matching-in-haskell/ -- -- By string =~ pattern we'll get the start of the match and the length of--- the matchas a (start, length) tuple if there's a match.+-- the matches a (start, length) tuple if there's a match. -- If match fails then it would be (-1,0) flexScore :: Text -> Text -> Maybe Double flexScore pat str =

@@ -11,28 +11,28 @@  idePrimDeclarations :: ModuleMap [IdeDeclarationAnn] idePrimDeclarations = Map.fromList-  [ ( C.Prim+  [ ( C.M_Prim     , mconcat [primTypes, primClasses]     )-  , ( C.PrimBoolean+  , ( C.M_Prim_Boolean     , mconcat [primBooleanTypes]     )-  , ( C.PrimOrdering+  , ( C.M_Prim_Ordering     , mconcat [primOrderingTypes]     )-  , ( C.PrimRow+  , ( C.M_Prim_Row     , mconcat [primRowTypes, primRowClasses]     )-  , ( C.PrimRowList+  , ( C.M_Prim_RowList     , mconcat [primRowListTypes, primRowListClasses]     )-  , ( C.PrimSymbol+  , ( C.M_Prim_Symbol     , mconcat [primSymbolTypes, primSymbolClasses]     )-  , ( C.PrimInt+  , ( C.M_Prim_Int     , mconcat [primIntTypes, primIntClasses]     )-  , ( C.PrimTypeError+  , ( C.M_Prim_TypeError     , mconcat [primTypeErrorTypes, primTypeErrorClasses]     )   ]

@@ -14,9 +14,12 @@ import           Data.Maybe                      (fromJust) import qualified Data.Set                        as S import qualified Data.Time                       as Time+import qualified Data.Text                       as Text import qualified Language.PureScript             as P+import           Language.PureScript.Make (ffiCodegen') import           Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache) import qualified Language.PureScript.CST         as CST+ import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Logging import           Language.PureScript.Ide.State@@ -51,7 +54,10 @@   -- ^ A runner for the second build with open exports   -> m Success rebuildFile file actualFile codegenTargets runOpenBuild = do-  (fp, input) <- ideReadFile file+  (fp, input) <-+    case List.stripPrefix "data:" file of+      Just source -> pure ("", Text.pack source)+      _ -> ideReadFile file   let fp' = fromMaybe fp actualFile   (pwarnings, m) <- case sequence $ CST.parseFromFile fp' input of     Left parseError ->@@ -65,13 +71,18 @@   -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign   -- modules using their file paths, we need to specify the path in the 'Map'.   let filePathMap = M.singleton moduleName (Left P.RebuildAlways)-  foreigns <- P.inferForeignModules (M.singleton moduleName (Right file))+  let pureRebuild = fp == ""+  let modulePath = if pureRebuild then fp' else file+  foreigns <- P.inferForeignModules (M.singleton moduleName (Right modulePath))   let makeEnv = P.buildMakeActions outputDirectory filePathMap foreigns False+        & (if pureRebuild then enableForeignCheck foreigns codegenTargets . shushCodegen else identity)+        & shushProgress   -- Rebuild the single module using the cached externs   (result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $     liftIO $ P.runMake (P.defaultOptions { P.optionsCodegenTargets = codegenTargets }) do-      newExterns <- P.rebuildModule (shushProgress makeEnv) externs m-      updateCacheDb codegenTargets outputDirectory file actualFile moduleName+      newExterns <- P.rebuildModule makeEnv externs m+      unless pureRebuild+        $ updateCacheDb codegenTargets outputDirectory file actualFile moduleName       pure newExterns   case result of     Left errors ->@@ -174,6 +185,16 @@ shushCodegen ma =   ma { P.codegen = \_ _ _ -> pure ()      , P.ffiCodegen = \_ -> pure ()+     }++-- | Enables foreign module check without actual codegen.+enableForeignCheck+  :: M.Map P.ModuleName FilePath+  -> S.Set P.CodegenTarget+  -> P.MakeActions P.Make+  -> P.MakeActions P.Make+enableForeignCheck foreigns codegenTargets ma =+  ma { P.ffiCodegen = ffiCodegen' foreigns codegenTargets Nothing      }  -- | Returns a topologically sorted list of dependent ExternsFiles for the given

@@ -207,7 +207,7 @@     (\mn -> logWarnN . prettyPrintReexportResult (const (P.runModuleName mn)))     (Map.filter reexportHasFailures results) -populateVolatileState :: (Ide m, MonadLogger m) => m (Async ())+populateVolatileState :: Ide m => m (Async ()) populateVolatileState = do   env <- ask   let ll = confLogLevel (ideConfiguration env)

@@ -25,7 +25,7 @@ -- module. -- 3. Apply the collected search specifications and collect the results findUsages-  :: (MonadIO m, Ide m)+  :: Ide m   => IdeDeclaration   -> P.ModuleName   -> m (ModuleMap (NonEmpty P.SourceSpan))

@@ -178,7 +178,7 @@  -- | Show actual loaded modules in psci. handleShowLoadedModules-  :: (MonadState PSCiState m, MonadIO m)+  :: MonadState PSCiState m   => (String -> m ())   -> m () handleShowLoadedModules print' = do@@ -189,7 +189,7 @@  -- | Show the imported modules in psci. handleShowImportedModules-  :: (MonadState PSCiState m, MonadIO m)+  :: MonadState PSCiState m   => (String -> m ())   -> m () handleShowImportedModules print' = do@@ -230,7 +230,7 @@   commaList = T.intercalate ", "  handleShowPrint-  :: (MonadState PSCiState m, MonadIO m)+  :: MonadState PSCiState m   => (String -> m ())   -> m () handleShowPrint print' = do@@ -305,7 +305,7 @@  -- | Browse a module and displays its signature handleBrowse-  :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)+  :: (MonadReader PSCiConfig m, MonadState PSCiState m)   => (String -> m ())   -> P.ModuleName   -> m ()

@@ -19,7 +19,7 @@ import Language.PureScript.Linter.Imports as L import Language.PureScript.Names import Language.PureScript.Types-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C  -- | Lint the PureScript AST. -- |@@ -162,7 +162,7 @@   thisModuleRef _ = False    rebindable :: S.Set Ident-  rebindable = S.fromList [ Ident C.bind, Ident C.discard ]+  rebindable = S.fromList [ Ident C.S_bind, Ident C.S_discard ]    getDeclIdent :: Declaration -> Maybe Ident   getDeclIdent = getIdentName <=< declName

@@ -15,7 +15,6 @@ import Control.Arrow (first, second) import Control.Monad (unless) import Control.Monad.Writer.Class-import Control.Monad.Supply.Class (MonadSupply)  import Data.List (foldl', sortOn) import Data.Maybe (fromMaybe)@@ -237,7 +236,7 @@ -- checkExhaustive   :: forall m-   . (MonadWriter MultipleErrors m, MonadSupply m)+   . MonadWriter MultipleErrors m    => SourceSpan    -> Environment    -> ModuleName@@ -292,7 +291,7 @@ -- checkExhaustiveExpr   :: forall m-   . (MonadWriter MultipleErrors m, MonadSupply m)+   . MonadWriter MultipleErrors m    => SourceSpan    -> Environment    -> ModuleName

@@ -142,7 +142,7 @@   -- Checks whether a module is the Prim module - used to suppress any checks   -- made, as Prim is always implicitly imported.   isPrim :: ModuleName -> Bool-  isPrim = (== C.Prim)+  isPrim = (== C.M_Prim)    -- Creates a map of virtual modules mapped to all the declarations that   -- import to that module, with the corresponding source span, import type,

@@ -56,7 +56,7 @@ -- This function is used for fast-rebuild workflows (PSCi and psc-ide are examples). rebuildModule   :: forall m-   . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+   . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => MakeActions m   -> [ExternsFile]   -> Module@@ -67,7 +67,7 @@  rebuildModule'   :: forall m-   . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+   . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => MakeActions m   -> Env   -> [ExternsFile]@@ -77,7 +77,7 @@  rebuildModuleWithIndex   :: forall m-   . (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+   . (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)   => MakeActions m   -> Env   -> [ExternsFile]@@ -136,7 +136,7 @@ -- -- If timestamps or hashes have not changed, existing externs files can be used to provide upstream modules' types without -- having to typecheck those modules again.-make :: forall m. (Monad m, MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)+make :: forall m. (MonadBaseControl IO m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)      => MakeActions m      -> [CST.PartialResult Module]      -> m [ExternsFile]

@@ -8,6 +8,7 @@   , cacheDbFile   , readCacheDb'   , writeCacheDb'+  , ffiCodegen'   ) where  import           Prelude@@ -280,23 +281,7 @@   ffiCodegen :: CF.Module CF.Ann -> Make ()   ffiCodegen m = do     codegenTargets <- asks optionsCodegenTargets-    when (S.member JS codegenTargets) $ do-      let mn = CF.moduleName m-      case mn `M.lookup` foreigns of-        Just path-          | not $ requiresForeign m ->-              tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path-          | otherwise -> do-              checkResult <- checkForeignDecls m path-              case checkResult of-                Left _ -> copyFile path (outputFilename mn "foreign.js")-                Right (ESModule, _) -> copyFile path (outputFilename mn "foreign.js")-                Right (CJSModule, _) -> do-                  throwError $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path--        Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn-                | otherwise -> return ()-+    ffiCodegen' foreigns codegenTargets (Just outputFilename) m    genSourceMap :: String -> String -> Int -> [SMap] -> Make ()   genSourceMap dir mapFile extraLines mappings = do@@ -308,7 +293,7 @@       map (\(SMap _ orig gen) -> Mapping {           mapOriginal = Just $ convertPos $ add 0 (-1) orig         , mapSourceFile = sourceFile-        , mapGenerated = convertPos $ add (extraLines+1) 0 gen+        , mapGenerated = convertPos $ add (extraLines + 1) 0 gen         , mapName = Nothing         }) mappings     }@@ -316,7 +301,7 @@     writeJSONFile mapFile mapping     where     add :: Int -> Int -> SourcePos -> SourcePos-    add n m (SourcePos n' m') = SourcePos (n+n') (m+m')+    add n m (SourcePos n' m') = SourcePos (n + n') (m + m')      convertPos :: SourcePos -> Pos     convertPos SourcePos { sourcePosLine = l, sourcePosColumn = c } =@@ -358,7 +343,7 @@   modSS = CF.moduleSourceSpan m    checkFFI :: JS.JSAST -> Make (ForeignModuleType, S.Set Ident)-  checkFFI js = do +  checkFFI js = do     (foreignModuleType, foreignIdentsStrs) <-         case (,) <$> getForeignModuleExports js <*> getForeignModuleImports js of           Left reason -> throwError $ errorParsingModule reason@@ -438,3 +423,33 @@       . CST.runTokenParser CST.parseIdent       . CST.lex       $ T.pack str++-- | FFI check and codegen action.+-- If path maker is supplied copies foreign module to the output.+ffiCodegen'+  :: M.Map ModuleName FilePath+  -> S.Set CodegenTarget+  -> Maybe (ModuleName -> String -> FilePath)+  -> CF.Module CF.Ann+  -> Make ()+ffiCodegen' foreigns codegenTargets makeOutputPath m = do+  when (S.member JS codegenTargets) $ do+    let mn = CF.moduleName m+    case mn `M.lookup` foreigns of+      Just path+        | not $ requiresForeign m ->+            tell $ errorMessage' (CF.moduleSourceSpan m) $ UnnecessaryFFIModule mn path+        | otherwise -> do+            checkResult <- checkForeignDecls m path+            case checkResult of+              Left _ -> copyForeign path mn+              Right (ESModule, _) -> copyForeign path mn+              Right (CJSModule, _) -> do+                throwError $ errorMessage' (CF.moduleSourceSpan m) $ DeprecatedFFICommonJSModule mn path+      Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn+              | otherwise -> return ()+  where+  requiresForeign = not . null . CF.moduleForeign++  copyForeign path mn =+    for_ makeOutputPath (\outputFilename -> copyFile path (outputFilename mn "foreign.js"))

@@ -127,7 +127,7 @@ -- The given MakeActions are used to collect various timestamps in order to -- determine whether a module needs rebuilding. construct-  :: forall m. (Monad m, MonadBaseControl IO m)+  :: forall m. MonadBaseControl IO m   => MakeActions m   -> CacheDb   -> ([CST.PartialResult Module], [(ModuleName, [ModuleName])])

@@ -96,8 +96,8 @@ bumpPos p (SMap f s g) = SMap f s $ p `addPos` g  addPos :: SourcePos -> SourcePos -> SourcePos-addPos (SourcePos n m) (SourcePos 0 m') = SourcePos n (m+m')-addPos (SourcePos n _) (SourcePos n' m') = SourcePos (n+n') m'+addPos (SourcePos n m) (SourcePos 0 m') = SourcePos n (m + m')+addPos (SourcePos n _) (SourcePos n' m') = SourcePos (n + n') m'   data PrinterState = PrinterState { indent :: Int }

@@ -12,7 +12,7 @@ import           Language.PureScript.AST import           Language.PureScript.Errors import           Language.PureScript.Names-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C  -- | Replace all @AdoNotationBind@ and @AdoNotationValue@ constructors with -- applications of the pure and apply functions in scope, and all @AdoNotationLet@@@ -28,13 +28,13 @@   in rethrowWithPosition ss $ f d   where   pure' :: SourceSpan -> Maybe ModuleName -> Expr-  pure' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.pure'))+  pure' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_pure))    map' :: SourceSpan -> Maybe ModuleName -> Expr-  map' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.map))+  map' ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_map))    apply :: SourceSpan -> Maybe ModuleName -> Expr-  apply ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.apply))+  apply ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_apply))    replace :: SourceSpan -> Expr -> m Expr   replace pos (Ado m els yield) = do

@@ -14,7 +14,7 @@ import           Language.PureScript.Crash import           Language.PureScript.Errors import           Language.PureScript.Names-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C  -- | Replace all @DoNotationBind@ and @DoNotationValue@ constructors with -- applications of the bind function in scope, and all @DoNotationLet@@@ -30,10 +30,10 @@   in rethrowWithPosition ss $ f d   where   bind :: SourceSpan -> Maybe ModuleName -> Expr-  bind ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.bind))+  bind ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_bind))    discard :: SourceSpan -> Maybe ModuleName -> Expr-  discard ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.discard))+  discard ss m = Var ss (Qualified (byMaybeModuleName m) (Ident C.S_discard))    replace :: SourceSpan -> Expr -> m Expr   replace pos (Do m els) = go pos m els@@ -57,7 +57,7 @@   go _ _ (DoNotationBind b _ : _) | First (Just ident) <- foldMap fromIdent (binderNames b) =       throwError . errorMessage $ CannotUseBindWithDo (Ident ident)     where-      fromIdent (Ident i) | i `elem` [ C.bind, C.discard ] = First (Just i)+      fromIdent (Ident i) | i `elem` [ C.S_bind, C.S_discard ] = First (Just i)       fromIdent _ = mempty   go pos m (DoNotationBind binder val : rest) = do     rest' <- go pos m rest@@ -75,7 +75,7 @@   go pos m (DoNotationLet ds : rest) = do     let checkBind :: Declaration -> m ()         checkBind (ValueDecl (ss, _) i@(Ident name) _ _ _)-          | name `elem` [ C.bind, C.discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i+          | name `elem` [ C.S_bind, C.S_discard ] = throwError . errorMessage' ss $ CannotUseBindWithDo i         checkBind _ = pure ()     mapM_ checkBind ds     rest' <- go pos m rest

@@ -10,14 +10,15 @@   ) where  import Prelude-import Protolude (ordNub, sortOn, swap, foldl')+import Protolude (sortOn, swap, foldl') -import Control.Arrow (first, second)+import Control.Arrow (first, second, (&&&)) import Control.Monad import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Lazy import Control.Monad.Writer (MonadWriter(..)) +import qualified Data.List.NonEmpty as NEL import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Set as S@@ -253,9 +254,15 @@   updateValue (pos, bound) (Abs (VarBinder ss arg) val') =     return ((pos, M.insert arg (spanStart ss) bound), Abs (VarBinder ss arg) val')   updateValue (pos, bound) (Let w ds val') = do-    let args = mapMaybe letBoundVariable ds-    unless (length (ordNub args) == length args) .-      throwError . errorMessage' pos $ OverlappingNamesInLet+    let+      args = mapMaybe letBoundVariable ds+      groupByFst = map (\ts -> (fst (NEL.head ts), snd <$> ts)) . NEL.groupAllWith fst+      duplicateArgsErrs = foldMap mkArgError $ groupByFst args+      mkArgError (ident, poses)+        | NEL.length poses < 2 = mempty+        | otherwise = errorMessage'' (NEL.reverse poses) (OverlappingNamesInLet ident)+    when (nonEmpty duplicateArgsErrs) $+      throwError duplicateArgsErrs     return ((pos, declarationsToMap ds `M.union` bound), Let w ds val')   updateValue (_, bound) (Var ss name'@(Qualified qualifiedBy ident)) =     ((ss, bound), ) <$> case (M.lookup ident bound, qualifiedBy) of@@ -324,8 +331,8 @@     . fmap (second spanStart . swap)     . binderNamesWithSpans -  letBoundVariable :: Declaration -> Maybe Ident-  letBoundVariable = fmap valdeclIdent . getValueDeclaration+  letBoundVariable :: Declaration -> Maybe (Ident, SourceSpan)+  letBoundVariable = fmap (valdeclIdent &&& (fst . valdeclSourceAnn)) . getValueDeclaration    declarationsToMap :: [Declaration] -> M.Map Ident SourcePos   declarationsToMap = foldl goDTM M.empty

@@ -40,7 +40,7 @@   -- but that requires additional changes in how warnings are printed.   -- Example of keeping all duplicates (not what this code currently does):   --  removeUnique [1,2,2,3,3,3,4] == [2,2,3,3,3]-  removeUnique :: Eq a => Ord a => [a] -> [a]+  removeUnique :: Ord a => [a] -> [a]   removeUnique = concatMap (drop 1) . group . sort    -- Deletes the constructor information from TypeRefs so that only the

@@ -246,31 +246,31 @@ -- | Environment which only contains the Prim modules. primEnv :: Env primEnv = M.fromList-  [ ( C.Prim+  [ ( C.M_Prim     , (internalModuleSourceSpan "<Prim>", nullImports, primExports)     )-  , ( C.PrimBoolean+  , ( C.M_Prim_Boolean     , (internalModuleSourceSpan "<Prim.Boolean>", nullImports, primBooleanExports)     )-  , ( C.PrimCoerce+  , ( C.M_Prim_Coerce     , (internalModuleSourceSpan "<Prim.Coerce>", nullImports, primCoerceExports)     )-  , ( C.PrimOrdering+  , ( C.M_Prim_Ordering     , (internalModuleSourceSpan "<Prim.Ordering>", nullImports, primOrderingExports)     )-  , ( C.PrimRow+  , ( C.M_Prim_Row     , (internalModuleSourceSpan "<Prim.Row>", nullImports, primRowExports)     )-  , ( C.PrimRowList+  , ( C.M_Prim_RowList     , (internalModuleSourceSpan "<Prim.RowList>", nullImports, primRowListExports)     )-  , ( C.PrimSymbol+  , ( C.M_Prim_Symbol     , (internalModuleSourceSpan "<Prim.Symbol>", nullImports, primSymbolExports)     )-  , ( C.PrimInt+  , ( C.M_Prim_Int     , (internalModuleSourceSpan "<Prim.Int>", nullImports, primIntExports)     )-  , ( C.PrimTypeError+  , ( C.M_Prim_TypeError     , (internalModuleSourceSpan "<Prim.TypeError>", nullImports, primTypeErrorExports)     )   ]

@@ -40,7 +40,7 @@ import qualified Data.Map as M import Data.Ord (Down(..)) -import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C  -- | -- Removes unary negation operators and replaces them with calls to `negate`.@@ -50,7 +50,7 @@   Module ss coms mn (map f' ds) exts   where   (f', _, _) = everywhereOnValues id go id-  go (UnaryMinus ss' val) = App (Var ss' (Qualified ByNullSourcePos (Ident C.negate))) val+  go (UnaryMinus ss' val) = App (Var ss' (Qualified ByNullSourcePos (Ident C.S_negate))) val   go other = other  -- |@@ -184,7 +184,7 @@ -- | Indicates whether the `rebracketModule` -- is being called with the full desugar pass -- run via `purs compile` or whether--- only the partial desguar pass is run+-- only the partial desugar pass is run -- via `purs docs`. -- This indication is needed to prevent -- a `purs docs` error when using@@ -216,7 +216,7 @@   -- and only some of the desugar passes when generating docs.   -- When generating docs, `case _ of` syntax used in an instance declaration   -- can trigger the `IncorrectAnonymousArgument` error because it does not-  -- run the same passes that the compile desguaring does. Since `purs docs`+  -- run the same passes that the compile desugaring does. Since `purs docs`   -- will only succeed once `purs compile` succeeds, we can ignore this check   -- when running `purs docs`.   -- See https://github.com/purescript/purescript/issues/4274#issuecomment-1087730651=

@@ -53,13 +53,13 @@   initialState :: MemberMap   initialState =     mconcat-      [ M.mapKeys (qualify C.Prim) primClasses-      , M.mapKeys (qualify C.PrimCoerce) primCoerceClasses-      , M.mapKeys (qualify C.PrimRow) primRowClasses-      , M.mapKeys (qualify C.PrimRowList) primRowListClasses-      , M.mapKeys (qualify C.PrimSymbol) primSymbolClasses-      , M.mapKeys (qualify C.PrimInt) primIntClasses-      , M.mapKeys (qualify C.PrimTypeError) primTypeErrorClasses+      [ M.mapKeys (qualify C.M_Prim) primClasses+      , M.mapKeys (qualify C.M_Prim_Coerce) primCoerceClasses+      , M.mapKeys (qualify C.M_Prim_Row) primRowClasses+      , M.mapKeys (qualify C.M_Prim_RowList) primRowListClasses+      , M.mapKeys (qualify C.M_Prim_Symbol) primSymbolClasses+      , M.mapKeys (qualify C.M_Prim_Int) primIntClasses+      , M.mapKeys (qualify C.M_Prim_TypeError) primTypeErrorClasses       , M.fromList (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)       ] 

@@ -9,8 +9,7 @@ import           Data.List (foldl', find, unzip5) import           Language.PureScript.AST import           Language.PureScript.AST.Utils-import qualified Language.PureScript.Constants.Data.Generic.Rep as DataGenericRep-import qualified Language.PureScript.Constants.Data.Newtype as DataNewtype+import qualified Language.PureScript.Constants.Libs as Libs import           Language.PureScript.Crash import           Language.PureScript.Environment import           Language.PureScript.Errors@@ -59,8 +58,8 @@         _ -> throwError . errorMessage' ss $ InvalidDerivedInstance className tys 2        in case className of-        DataNewtype.Newtype -> binaryWildcardClass deriveNewtype-        DataGenericRep.Generic -> binaryWildcardClass (deriveGenericRep ss mn)+        Libs.Generic -> binaryWildcardClass (deriveGenericRep ss mn)+        Libs.Newtype -> binaryWildcardClass deriveNewtype         _ -> pure decl     _ -> pure decl @@ -84,13 +83,13 @@                       lamCase x                         [ CaseAlternative                             [NullBinder]-                            (unguarded (App (Var ss DataGenericRep.to) (Var ss' (Qualified ByNullSourcePos x))))+                            (unguarded (App (Var ss Libs.I_to) (Var ss' (Qualified ByNullSourcePos x))))                         ]                    , ValueDecl (ss', []) (Ident "from") Public [] $ unguarded $                       lamCase x                         [ CaseAlternative                             [NullBinder]-                            (unguarded (App (Var ss DataGenericRep.from) (Var ss' (Qualified ByNullSourcePos x))))+                            (unguarded (App (Var ss Libs.I_from) (Var ss' (Qualified ByNullSourcePos x))))                         ]                    ]                | otherwise =@@ -112,12 +111,12 @@     select l r n = take (n - 1) (iterate (r .) l) ++ [compN (n - 1) r]      sumBinders :: Int -> [Binder -> Binder]-    sumBinders = select (ConstructorBinder ss DataGenericRep.Inl . pure)-                        (ConstructorBinder ss DataGenericRep.Inr . pure)+    sumBinders = select (ConstructorBinder ss Libs.C_Inl . pure)+                        (ConstructorBinder ss Libs.C_Inr . pure)      sumExprs :: Int -> [Expr -> Expr]-    sumExprs = select (App (Constructor ss DataGenericRep.Inl))-                      (App (Constructor ss DataGenericRep.Inr))+    sumExprs = select (App (Constructor ss Libs.C_Inl))+                      (App (Constructor ss Libs.C_Inr))      compN :: Int -> (a -> a) -> a -> a     compN 0 _ = id@@ -129,37 +128,37 @@     makeInst (DataConstructorDeclaration _ ctorName args) = do         let args' = map snd args         (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'-        return ( srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Constructor)+        return ( srcTypeApp (srcTypeApp (srcTypeConstructor Libs.Constructor)                                   (srcTypeLevelString $ mkString (runProperName ctorName)))                          ctorTy-               , CaseAlternative [ ConstructorBinder ss DataGenericRep.Constructor [matchProduct] ]+               , CaseAlternative [ ConstructorBinder ss Libs.C_Constructor [matchProduct] ]                                  (unguarded (foldl' App (Constructor ss (Qualified (ByModuleName mn) ctorName)) ctorArgs))                , CaseAlternative [ ConstructorBinder ss (Qualified (ByModuleName mn) ctorName) matchCtor ]-                                 (unguarded (App (Constructor ss DataGenericRep.Constructor) mkProduct))+                                 (unguarded (App (Constructor ss Libs.C_Constructor) mkProduct))                )      makeProduct       :: [SourceType]       -> m (SourceType, Binder, [Expr], [Binder], Expr)     makeProduct [] =-      pure (srcTypeConstructor DataGenericRep.NoArguments, NullBinder, [], [], Constructor ss DataGenericRep.NoArguments)+      pure (srcTypeConstructor Libs.NoArguments, NullBinder, [], [], Constructor ss Libs.C_NoArguments)     makeProduct args = do       (tys, bs1, es1, bs2, es2) <- unzip5 <$> traverse makeArg args-      pure ( foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Product) f)) tys-           , foldr1 (\b1 b2 -> ConstructorBinder ss DataGenericRep.Product [b1, b2]) bs1+      pure ( foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor Libs.Product) f)) tys+           , foldr1 (\b1 b2 -> ConstructorBinder ss Libs.C_Product [b1, b2]) bs1            , es1            , bs2-           , foldr1 (\e1 -> App (App (Constructor ss DataGenericRep.Product) e1)) es2+           , foldr1 (\e1 -> App (App (Constructor ss Libs.C_Product) e1)) es2            )      makeArg :: SourceType -> m (SourceType, Binder, Expr, Binder, Expr)     makeArg arg = do       argName <- freshIdent "arg"-      pure ( srcTypeApp (srcTypeConstructor DataGenericRep.Argument) arg-           , ConstructorBinder ss DataGenericRep.Argument [ VarBinder ss argName ]+      pure ( srcTypeApp (srcTypeConstructor Libs.Argument) arg+           , ConstructorBinder ss Libs.C_Argument [ VarBinder ss argName ]            , Var ss (Qualified (BySourcePos $ spanStart ss) argName)            , VarBinder ss argName-           , App (Constructor ss DataGenericRep.Argument) (Var ss (Qualified (BySourcePos $ spanStart ss) argName))+           , App (Constructor ss Libs.C_Argument) (Var ss (Qualified (BySourcePos $ spanStart ss) argName))            )      underBinder :: (Binder -> Binder) -> CaseAlternative -> CaseAlternative@@ -170,9 +169,9 @@     underExpr _ _ = internalError "underExpr: expected unguarded alternative"      toRepTy :: [SourceType] -> SourceType-    toRepTy [] = srcTypeConstructor DataGenericRep.NoConstructors+    toRepTy [] = srcTypeConstructor Libs.NoConstructors     toRepTy [only] = only-    toRepTy ctors = foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor DataGenericRep.Sum) f)) ctors+    toRepTy ctors = foldr1 (\f -> srcTypeApp (srcTypeApp (srcTypeConstructor Libs.Sum) f)) ctors  checkIsWildcard :: MonadError MultipleErrors m => SourceSpan -> ProperName 'TypeName -> SourceType -> m () checkIsWildcard _ _ (TypeWildcard _ UnnamedWildcard) = return ()

@@ -29,8 +29,7 @@  import Language.PureScript.AST import Language.PureScript.AST.Declarations.ChainId (ChainId)-import qualified Language.PureScript.Constants.Data.Generic.Rep as DataGenericRep-import qualified Language.PureScript.Constants.Data.Newtype as DataNewtype+import qualified Language.PureScript.Constants.Libs as Libs import Language.PureScript.Crash import Language.PureScript.Environment import Language.PureScript.Errors@@ -789,8 +788,8 @@   checkDataConstructorsAreExported :: DeclarationRef -> m ()   checkDataConstructorsAreExported dr@(TypeRef ss' name (fromMaybe [] -> exportedDataConstructorsNames))     | null exportedDataConstructorsNames = for_-      [ DataGenericRep.Generic-      , DataNewtype.Newtype+      [ Libs.Generic+      , Libs.Newtype       ] $ \className -> do         env <- getEnv         let dicts = foldMap (foldMap NEL.toList) $

@@ -5,18 +5,20 @@  import Protolude hiding (Type) +import Control.Lens (both, over)+import Control.Monad.Error.Class (liftEither) import Control.Monad.Trans.Writer (Writer, WriterT, runWriter, runWriterT) import Control.Monad.Writer.Class (MonadWriter(..))+import Data.Align (align, unalign) import Data.Foldable (foldl1, foldr1) import Data.List (init, last, zipWith3, (!!)) import qualified Data.Map as M+import Data.These (These(..), mergeTheseWith, these)  import Control.Monad.Supply.Class import Language.PureScript.AST import Language.PureScript.AST.Utils-import qualified Language.PureScript.Constants.Data.Foldable as Foldable-import qualified Language.PureScript.Constants.Data.Traversable as Traversable-import qualified Language.PureScript.Constants.Prelude as Prelude+import qualified Language.PureScript.Constants.Libs as Libs import qualified Language.PureScript.Constants.Prim as Prim import Language.PureScript.Crash import Language.PureScript.Environment@@ -25,6 +27,7 @@ import Language.PureScript.Names import Language.PureScript.PSString import Language.PureScript.Sugar.TypeClasses+import Language.PureScript.TypeChecker.Entailment import Language.PureScript.TypeChecker.Monad import Language.PureScript.TypeChecker.Synonyms import Language.PureScript.TypeClassDictionaries@@ -78,13 +81,18 @@       unaryClass' f = unaryClass (f className)        in case className of-        Foldable.Foldable -> unaryClass' deriveFoldable-        Prelude.Eq -> unaryClass deriveEq-        Prelude.Eq1 -> unaryClass $ \_ _ -> deriveEq1-        Prelude.Functor -> unaryClass' deriveFunctor-        Prelude.Ord -> unaryClass deriveOrd-        Prelude.Ord1 -> unaryClass $ \_ _ -> deriveOrd1-        Traversable.Traversable -> unaryClass' deriveTraversable+        Libs.Bifoldable -> unaryClass' $ deriveFoldable True+        Libs.Bifunctor -> unaryClass' $ deriveFunctor (Just False) False Libs.S_bimap+        Libs.Bitraversable -> unaryClass' $ deriveTraversable True+        Libs.Contravariant -> unaryClass' $ deriveFunctor Nothing True Libs.S_cmap+        Libs.Eq -> unaryClass deriveEq+        Libs.Eq1 -> unaryClass $ \_ _ -> deriveEq1+        Libs.Foldable -> unaryClass' $ deriveFoldable False+        Libs.Functor -> unaryClass' $ deriveFunctor Nothing False Libs.S_map+        Libs.Ord -> unaryClass deriveOrd+        Libs.Ord1 -> unaryClass $ \_ _ -> deriveOrd1+        Libs.Profunctor -> unaryClass' $ deriveFunctor (Just True) False Libs.S_dimap+        Libs.Traversable -> unaryClass' $ deriveTraversable False         -- See L.P.Sugar.TypeClasses.Deriving for the classes that can be         -- derived prior to type checking.         _ -> throwError . errorMessage $ CannotDerive className tys@@ -101,7 +109,6 @@   :: forall m    . MonadError MultipleErrors m   => MonadState CheckState m-  => MonadSupply m   => MonadWriter MultipleErrors m   => ModuleName   -> Qualified (ProperName 'ClassName)@@ -194,7 +201,7 @@ deriveEq mn tyConNm = do   (_, _, _, ctors) <- lookupTypeDecl mn tyConNm   eqFun <- mkEqFunction ctors-  pure [(Prelude.eq, eqFun)]+  pure [(Libs.S_eq, eqFun)]   where     mkEqFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr     mkEqFunction ctors = do@@ -203,13 +210,13 @@       lamCase2 x y . addCatch <$> mapM mkCtorClause ctors      preludeConj :: Expr -> Expr -> Expr-    preludeConj = App . App (mkVarMn (Just (ModuleName "Data.HeytingAlgebra")) (Ident Prelude.conj))+    preludeConj = App . App (mkRef Libs.I_conj)      preludeEq :: Expr -> Expr -> Expr-    preludeEq = App . App (mkRef Prelude.identEq)+    preludeEq = App . App (mkRef Libs.I_eq)      preludeEq1 :: Expr -> Expr -> Expr-    preludeEq1 = App . App (mkRef Prelude.identEq1)+    preludeEq1 = App . App (mkRef Libs.I_eq1)      addCatch :: [CaseAlternative] -> [CaseAlternative]     addCatch xs@@ -243,7 +250,7 @@       | otherwise = preludeEq l r  deriveEq1 :: forall m. Applicative m => m [(PSString, Expr)]-deriveEq1 = pure [(Prelude.eq1, mkRef Prelude.identEq)]+deriveEq1 = pure [(Libs.S_eq1, mkRef Libs.I_eq)]  deriveOrd   :: forall m@@ -256,7 +263,7 @@ deriveOrd mn tyConNm = do   (_, _, _, ctors) <- lookupTypeDecl mn tyConNm   compareFun <- mkCompareFunction ctors-  pure [(Prelude.compare, compareFun)]+  pure [(Libs.S_compare, compareFun)]   where     mkCompareFunction :: [(ProperName 'ConstructorName, [SourceType])] -> m Expr     mkCompareFunction ctors = do@@ -286,10 +293,10 @@     orderingBinder name = mkCtorBinder orderingMod (ProperName name) []      ordCompare :: Expr -> Expr -> Expr-    ordCompare = App . App (mkRef Prelude.identCompare)+    ordCompare = App . App (mkRef Libs.I_compare)      ordCompare1 :: Expr -> Expr -> Expr-    ordCompare1 = App . App (mkRef Prelude.identCompare1)+    ordCompare1 = App . App (mkRef Libs.I_compare1)      mkCtorClauses :: ((ProperName 'ConstructorName, [SourceType]), Bool) -> m [CaseAlternative]     mkCtorClauses ((ctorName, tys), isLast) = do@@ -330,7 +337,7 @@       | otherwise = ordCompare l r  deriveOrd1 :: forall m. Applicative m => m [(PSString, Expr)]-deriveOrd1 = pure [(Prelude.compare1, mkRef Prelude.identCompare)]+deriveOrd1 = pure [(Libs.S_compare1, mkRef Libs.I_compare)]  lookupTypeDecl   :: forall m@@ -369,78 +376,183 @@   where go (RCons _ str typ typs) = (str, typ) : go typs         go _ = [] -data ParamUsage+-- | The parameter `c` is used to allow or forbid contravariance for different+-- type classes. When deriving a type class that is a variation on Functor, a+-- witness for `c` will be provided; when deriving a type class that is a+-- variation on Foldable or Traversable, `c` will be Void and the contravariant+-- ParamUsage constructor can be skipped in pattern matching.+data ParamUsage c   = IsParam-  | MentionsParam ParamUsage-  | IsRecord (NonEmpty (PSString, ParamUsage))+  | IsLParam+    -- ^ enables biparametric classes (of any variance) to be derived+  | MentionsParam (ParamUsage c)+    -- ^ enables monoparametric classes to be used in a derivation+  | MentionsParamBi (These (ParamUsage c) (ParamUsage c))+    -- ^ enables biparametric classes to be used in a derivation+  | MentionsParamContravariantly !c (ContravariantParamUsage c)+    -- ^ enables contravariant classes (of either parametricity) to be used in a derivation+  | IsRecord (NonEmpty (PSString, ParamUsage c)) +data ContravariantParamUsage c+  = MentionsParamContra (ParamUsage c)+    -- ^ enables Contravariant to be used in a derivation+  | MentionsParamPro (These (ParamUsage c) (ParamUsage c))+    -- ^ enables Profunctor to be used in a derivation++data CovariantClasses = CovariantClasses+  { monoClass :: Qualified (ProperName 'ClassName)+  , biClass :: Qualified (ProperName 'ClassName)+  }++data ContravariantClasses = ContravariantClasses+  { contraClass :: Qualified (ProperName 'ClassName)+  , proClass :: Qualified (ProperName 'ClassName)+  }++data ContravarianceSupport c = ContravarianceSupport+  { contravarianceWitness :: c+  , paramIsContravariant :: Bool+  , lparamIsContravariant :: Bool+  , contravariantClasses :: ContravariantClasses+  }++-- | Return, if possible, a These the contents of which each satisfy the+-- predicate.+filterThese :: forall a. (a -> Bool) -> These a a -> Maybe (These a a)+filterThese p = uncurry align . over both (mfilter p) . unalign . Just+ validateParamsInTypeConstructors-  :: forall m+  :: forall c m    . MonadError MultipleErrors m   => MonadState CheckState m   => Qualified (ProperName 'ClassName)   -> ModuleName   -> ProperName 'TypeName-  -> m [(ProperName 'ConstructorName, [Maybe ParamUsage])]-validateParamsInTypeConstructors derivingClass mn tyConNm = do+  -> Bool+  -> CovariantClasses+  -> Maybe (ContravarianceSupport c)+  -> m [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])]+validateParamsInTypeConstructors derivingClass mn tyConNm isBi CovariantClasses{..} contravarianceSupport = do   (_, _, tyArgNames, ctors) <- lookupTypeDecl mn tyConNm-  param <- note (errorMessage $ KindsDoNotUnify (kindType -:> kindType) kindType) . lastMay $ map fst tyArgNames+  (mbLParam, param) <- liftEither . first (errorMessage . flip KindsDoNotUnify kindType . (kindType -:>)) $+    case (isBi, reverse $ map fst tyArgNames) of+      (False, x : _)    -> Right (Nothing, x)+      (False, _)        -> Left kindType+      (True, y : x : _) -> Right (Just x, y)+      (True, _ : _)     -> Left kindType+      (True, _)         -> Left $ kindType -:> kindType   ctors' <- traverse (traverse $ traverse replaceAllTypeSynonyms) ctors-  let (ctorUsages, problemSpans) = runWriter $ traverse (traverse . traverse $ typeToUsageOf param) ctors'+  tcds <- getTypeClassDictionaries+  let (ctorUsages, problemSpans) = runWriter $ traverse (traverse . traverse $ typeToUsageOf tcds (maybe That These mbLParam param) False) ctors'+  let relatedClasses = [monoClass, biClass] ++ ([contraClass, proClass] <*> (contravariantClasses <$> toList contravarianceSupport))   for_ (nonEmpty $ ordNub problemSpans) $ \sss ->-    throwError . addHint (RelatedPositions sss) . errorMessage $ CannotDeriveInvalidConstructorArg derivingClass+    throwError . addHint (RelatedPositions sss) . errorMessage $ CannotDeriveInvalidConstructorArg derivingClass relatedClasses (isJust contravarianceSupport)   pure ctorUsages+   where-  typeToUsageOf :: Text -> SourceType -> Writer [SourceSpan] (Maybe ParamUsage)-  typeToUsageOf param = go-    where+  typeToUsageOf :: InstanceContext -> These Text Text -> Bool -> SourceType -> Writer [SourceSpan] (Maybe (ParamUsage c))+  typeToUsageOf tcds = fix $ \go params isNegative -> let+    goCo = go params isNegative+    goContra = go params $ not isNegative+     assertNoParamUsedIn :: SourceType -> Writer [SourceSpan] ()-    assertNoParamUsedIn = everythingOnTypes (*>) $ \case+    assertNoParamUsedIn ty = void $ both (flip assertParamNotUsedIn ty) params++    assertParamNotUsedIn :: Text -> SourceType -> Writer [SourceSpan] ()+    assertParamNotUsedIn param = everythingOnTypes (*>) $ \case       TypeVar (ss, _) name | name == param -> tell [ss]       _ -> pure () -    go = \case+    tryBiClasses ht tyLArg tyArg+      | hasInstance tcds ht biClass+        = goCo tyLArg >>= preferMonoClass MentionsParamBi+      | Just (ContravarianceSupport c _ _ ContravariantClasses{..}) <- contravarianceSupport, hasInstance tcds ht proClass+        = goContra tyLArg >>= preferMonoClass (MentionsParamContravariantly c . MentionsParamPro)+      | otherwise+        = assertNoParamUsedIn tyLArg *> tryMonoClasses ht tyArg+      where+      preferMonoClass f lUsage =+        (if isNothing lUsage && hasInstance tcds ht monoClass then fmap MentionsParam else fmap f . align lUsage) <$> goCo tyArg++    tryMonoClasses ht tyArg+      | hasInstance tcds ht monoClass+        = fmap MentionsParam <$> goCo tyArg+      | Just (ContravarianceSupport c _ _ ContravariantClasses{..}) <- contravarianceSupport, hasInstance tcds ht contraClass+        = fmap (MentionsParamContravariantly c . MentionsParamContra) <$> goContra tyArg+      | otherwise+        = assertNoParamUsedIn tyArg $> Nothing++    in \case       ForAll _ name _ ty _ ->-        if name == param then pure Nothing else go ty+        fmap join . traverse (\params' -> go params' isNegative ty) $ filterThese (/= name) params        ConstrainedType _ _ ty ->-        go ty+        goCo ty        TypeApp _ (TypeConstructor _ Prim.Record) row ->         fmap (fmap IsRecord . nonEmpty . catMaybes) . for (decomposeRec' row) $ \(Label lbl, ty) ->-          fmap (lbl, ) <$> go ty+          fmap (lbl, ) <$> goCo ty -      TypeApp _ tyFn tyArg -> do-        assertNoParamUsedIn tyFn-        fmap MentionsParam <$> go tyArg+      TypeApp _ (TypeApp _ tyFn tyLArg) tyArg ->+        assertNoParamUsedIn tyFn *> tryBiClasses (headOfType tyFn) tyLArg tyArg -      TypeVar _ name ->-        pure $ (name == param) `orEmpty` IsParam+      TypeApp _ tyFn tyArg ->+        assertNoParamUsedIn tyFn *> tryMonoClasses (headOfType tyFn) tyArg +      TypeVar (ss, _) name -> mergeTheseWith (checkName lparamIsContra IsLParam) (checkName paramIsContra IsParam) (liftA2 (<|>)) params+        where+        checkName thisParamIsContra usage param+          | name == param = when (thisParamIsContra /= isNegative) (tell [ss]) $> Just usage+          | otherwise = pure Nothing+       ty ->         assertNoParamUsedIn ty $> Nothing +  paramIsContra = any paramIsContravariant contravarianceSupport+  lparamIsContra = any lparamIsContravariant contravarianceSupport++  hasInstance :: InstanceContext -> Qualified (Either Text (ProperName 'TypeName)) -> Qualified (ProperName 'ClassName) -> Bool+  hasInstance tcds ht@(Qualified qb _) cn@(Qualified cqb _) =+    any tcdAppliesToType $ concatMap (findDicts tcds cn) (ordNub [ByNullSourcePos, cqb, qb])+    where+    tcdAppliesToType tcd = case tcdInstanceTypes tcd of+      [headOfType -> ht'] -> ht == ht'+      -- ^ It's possible that, if ht and ht' are Lefts, this might require+      -- verifying that the name isn't shadowed by something in tcdForAll. I+      -- can't devise a legal program that causes this issue, but if in the+      -- future it seems like a good idea, it probably is.+      _ -> False++  headOfType :: SourceType -> Qualified (Either Text (ProperName 'TypeName))+  headOfType = fix $ \go -> \case+    TypeApp _ ty _ -> go ty+    KindApp _ ty _ -> go ty+    TypeVar _ nm -> Qualified ByNullSourcePos (Left nm)+    Skolem _ nm _ _ _ -> Qualified ByNullSourcePos (Left nm)+    TypeConstructor _ (Qualified qb nm) -> Qualified qb (Right nm)+    ty -> internalError $ "headOfType missing a case: " <> show (void ty)+ usingLamIdent :: forall m. MonadSupply m => (Expr -> m Expr) -> m Expr usingLamIdent cb = do   ident <- freshIdent "v"   lam ident <$> cb (mkVar ident) -traverseFields :: forall f. Applicative f => (ParamUsage -> Expr -> f Expr) -> NonEmpty (PSString, ParamUsage) -> Expr -> f Expr+traverseFields :: forall c f. Applicative f => (ParamUsage c -> Expr -> f Expr) -> NonEmpty (PSString, ParamUsage c) -> Expr -> f Expr traverseFields f fields r = fmap (ObjectUpdate r) . for (toList fields) $ \(lbl, usage) -> (lbl, ) <$> f usage (Accessor lbl r) -unnestRecords :: forall f. Applicative f => (ParamUsage -> Expr -> f Expr) -> ParamUsage -> Expr -> f Expr+unnestRecords :: forall c f. Applicative f => (ParamUsage c -> Expr -> f Expr) -> ParamUsage c -> Expr -> f Expr unnestRecords f = fix $ \go -> \case   IsRecord fields -> traverseFields go fields   usage -> f usage  mkCasesForTraversal-  :: forall f m+  :: forall c f m    . Applicative f -- this effect distinguishes the semantics of maps, folds, and traversals   => MonadSupply m   => ModuleName-  -> (ParamUsage -> Expr -> f Expr) -- how to handle constructor arguments+  -> (ParamUsage c -> Expr -> f Expr) -- how to handle constructor arguments   -> (f Expr -> m Expr) -- resolve the applicative effect into an expression-  -> [(ProperName 'ConstructorName, [Maybe ParamUsage])]+  -> [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])]   -> m Expr mkCasesForTraversal mn handleArg extractExpr ctors = do   m <- freshIdent "m"@@ -451,51 +563,107 @@     fmap (CaseAlternative [caseBinder] . unguarded) . extractExpr $       fmap (foldl' App ctor) . for ctorArgs $ \(ident, mbUsage) -> maybe pure handleArg mbUsage $ mkVar ident +data TraversalExprs = TraversalExprs+  { recurseVar :: Expr -- a var representing map, foldMap, or traverse, for handling structured values+  , birecurseVar :: Expr -- same, but bimap, bifoldMap, or bitraverse+  , lrecurseExpr :: Expr -- same, but lmap or ltraverse (there is no lfoldMap, but we can use `flip bifoldMap mempty`)+  , rrecurseExpr :: Expr -- same, but rmap or rtraverse etc., which conceptually should be the same as recurseVar but the bi classes aren't subclasses of the mono classes+  }++data ContraversalExprs = ContraversalExprs+  { crecurseVar :: Expr+  , direcurseVar :: Expr+  , lcrecurseVar :: Expr+  , rprorecurseVar :: Expr+  }++appBirecurseExprs :: TraversalExprs -> These Expr Expr -> Expr+appBirecurseExprs TraversalExprs{..} = these (App lrecurseExpr) (App rrecurseExpr) (App . App birecurseVar)++appDirecurseExprs :: ContraversalExprs -> These Expr Expr -> Expr+appDirecurseExprs ContraversalExprs{..} = these (App lcrecurseVar) (App rprorecurseVar) (App . App direcurseVar)+ data TraversalOps m = forall f. Applicative f => TraversalOps   { visitExpr :: m Expr -> f Expr -- lift an expression into the applicative effect defining the traversal   , extractExpr :: f Expr -> m Expr -- resolve the applicative effect into an expression   }  mkTraversal-  :: forall m+  :: forall c m    . MonadSupply m   => ModuleName-  -> Expr -- a var representing map, foldMap, or traverse, for handling structured values+  -> Bool+  -> TraversalExprs+  -> (c -> ContraversalExprs)   -> TraversalOps m-  -> [(ProperName 'ConstructorName, [Maybe ParamUsage])]+  -> [(ProperName 'ConstructorName, [Maybe (ParamUsage c)])]   -> m Expr-mkTraversal mn recurseVar (TraversalOps @_ @f visitExpr extractExpr) ctors = do+mkTraversal mn isBi te@TraversalExprs{..} getContraversalExprs (TraversalOps @_ @f visitExpr extractExpr) ctors = do   f <- freshIdent "f"+  g <- if isBi then freshIdent "g" else pure f   let-    handleValue :: ParamUsage -> Expr -> f Expr+    handleValue :: ParamUsage c -> Expr -> f Expr     handleValue = unnestRecords $ \usage inputExpr -> visitExpr $ flip App inputExpr <$> mkFnExprForValue usage -    mkFnExprForValue :: ParamUsage -> m Expr+    mkFnExprForValue :: ParamUsage c -> m Expr     mkFnExprForValue = \case       IsParam ->+        pure $ mkVar g+      IsLParam ->         pure $ mkVar f       MentionsParam innerUsage ->         App recurseVar <$> mkFnExprForValue innerUsage+      MentionsParamBi theseInnerUsages ->+        appBirecurseExprs te <$> both mkFnExprForValue theseInnerUsages+      MentionsParamContravariantly c contraUsage -> do+        let ce@ContraversalExprs{..} = getContraversalExprs c+        case contraUsage of+          MentionsParamContra innerUsage ->+            App crecurseVar <$> mkFnExprForValue innerUsage+          MentionsParamPro theseInnerUsages ->+            appDirecurseExprs ce <$> both mkFnExprForValue theseInnerUsages       IsRecord fields ->         usingLamIdent $ extractExpr . traverseFields handleValue fields -  lam f <$> mkCasesForTraversal mn handleValue extractExpr ctors+  lam f . applyWhen isBi (lam g) <$> mkCasesForTraversal mn handleValue extractExpr ctors  deriveFunctor   :: forall m    . MonadError MultipleErrors m   => MonadState CheckState m   => MonadSupply m-  => Qualified (ProperName 'ClassName)+  => Maybe Bool -- does left parameter exist, and is it contravariant?+  -> Bool -- is the (right) parameter contravariant?+  -> PSString -- name of the map function for this functor type+  -> Qualified (ProperName 'ClassName)   -> ModuleName   -> ProperName 'TypeName   -> m [(PSString, Expr)]-deriveFunctor nm mn tyConNm = do-  ctors <- validateParamsInTypeConstructors nm mn tyConNm-  mapFun <- mkTraversal mn mapVar (TraversalOps identity identity) ctors-  pure [(Prelude.map, mapFun)]+deriveFunctor mbLParamIsContravariant paramIsContravariant mapName nm mn tyConNm = do+  ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi functorClasses $ Just $ ContravarianceSupport+    { contravarianceWitness = ()+    , paramIsContravariant+    , lparamIsContravariant = or mbLParamIsContravariant+    , contravariantClasses+    }+  mapFun <- mkTraversal mn isBi mapExprs (const cmapExprs) (TraversalOps identity identity) ctors+  pure [(mapName, mapFun)]   where-  mapVar = mkRef Prelude.identMap+  isBi = isJust mbLParamIsContravariant+  mapExprs = TraversalExprs+    { recurseVar = mkRef Libs.I_map+    , birecurseVar = mkRef Libs.I_bimap+    , lrecurseExpr = mkRef Libs.I_lmap+    , rrecurseExpr = mkRef Libs.I_rmap+    }+  cmapExprs = ContraversalExprs+    { crecurseVar = mkRef Libs.I_cmap+    , direcurseVar = mkRef Libs.I_dimap+    , lcrecurseVar = mkRef Libs.I_lcmap+    , rprorecurseVar = mkRef Libs.I_profunctorRmap+    }+  functorClasses = CovariantClasses Libs.Functor Libs.Bifunctor+  contravariantClasses = ContravariantClasses Libs.Contravariant Libs.Profunctor  toConst :: forall f a b. f a -> Const [f a] b toConst = Const . pure@@ -511,42 +679,74 @@    . MonadError MultipleErrors m   => MonadState CheckState m   => MonadSupply m-  => Qualified (ProperName 'ClassName)+  => Bool -- is there a left parameter (are we deriving Bifoldable)?+  -> Qualified (ProperName 'ClassName)   -> ModuleName   -> ProperName 'TypeName   -> m [(PSString, Expr)]-deriveFoldable nm mn tyConNm = do-  ctors <- validateParamsInTypeConstructors nm mn tyConNm-  foldlFun <- mkAsymmetricFoldFunction False foldlVar ctors-  foldrFun <- mkAsymmetricFoldFunction True foldrVar ctors-  foldMapFun <- mkTraversal mn foldMapVar foldMapOps ctors-  pure [(Foldable.foldl, foldlFun), (Foldable.foldr, foldrFun), (Foldable.foldMap, foldMapFun)]+deriveFoldable isBi nm mn tyConNm = do+  ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi foldableClasses Nothing+  foldlFun <- mkAsymmetricFoldFunction False foldlExprs ctors+  foldrFun <- mkAsymmetricFoldFunction True foldrExprs ctors+  foldMapFun <- mkTraversal mn isBi foldMapExprs absurd foldMapOps ctors+  pure+    [ (if isBi then Libs.S_bifoldl else Libs.S_foldl, foldlFun)+    , (if isBi then Libs.S_bifoldr else Libs.S_foldr, foldrFun)+    , (if isBi then Libs.S_bifoldMap else Libs.S_foldMap, foldMapFun)+    ]   where-  foldlVar = mkRef Foldable.identFoldl-  foldrVar = mkRef Foldable.identFoldr-  foldMapVar = mkRef Foldable.identFoldMap-  flipVar = mkRef Prelude.identFlip+  foldableClasses = CovariantClasses Libs.Foldable Libs.Bifoldable+  foldlExprs = TraversalExprs+    { recurseVar = mkRef Libs.I_foldl+    , birecurseVar = bifoldlVar+    , lrecurseExpr = App (App flipVar bifoldlVar) constVar+    , rrecurseExpr = App bifoldlVar constVar+    }+  foldrExprs = TraversalExprs+    { recurseVar = mkRef Libs.I_foldr+    , birecurseVar = bifoldrVar+    , lrecurseExpr = App (App flipVar bifoldrVar) (App constVar identityVar)+    , rrecurseExpr = App bifoldrVar (App constVar identityVar)+    }+  foldMapExprs = TraversalExprs+    { recurseVar = mkRef Libs.I_foldMap+    , birecurseVar = bifoldMapVar+    , lrecurseExpr = App (App flipVar bifoldMapVar) memptyVar+    , rrecurseExpr = App bifoldMapVar memptyVar+    }+  bifoldlVar = mkRef Libs.I_bifoldl+  bifoldrVar = mkRef Libs.I_bifoldr+  bifoldMapVar = mkRef Libs.I_bifoldMap+  constVar = mkRef Libs.I_const+  flipVar = mkRef Libs.I_flip+  identityVar = mkRef Libs.I_identity+  memptyVar = mkRef Libs.I_mempty -  mkAsymmetricFoldFunction :: Bool -> Expr -> [(ProperName 'ConstructorName, [Maybe ParamUsage])] -> m Expr-  mkAsymmetricFoldFunction isRightFold recurseVar ctors = do+  mkAsymmetricFoldFunction :: Bool -> TraversalExprs -> [(ProperName 'ConstructorName, [Maybe (ParamUsage Void)])] -> m Expr+  mkAsymmetricFoldFunction isRightFold te@TraversalExprs{..} ctors = do     f <- freshIdent "f"+    g <- if isBi then freshIdent "g" else pure f     z <- freshIdent "z"     let       appCombiner :: (Bool, Expr) -> Expr -> Expr -> Expr       appCombiner (isFlipped, fn) = applyWhen (isFlipped == isRightFold) flip $ App . App fn -      mkCombinerExpr :: ParamUsage -> m Expr+      mkCombinerExpr :: ParamUsage Void -> m Expr       mkCombinerExpr = fmap (uncurry $ \isFlipped -> applyWhen isFlipped $ App flipVar) . getCombiner -      handleValue :: ParamUsage -> Expr -> Const [m (Expr -> Expr)] Expr+      handleValue :: ParamUsage Void -> Expr -> Const [m (Expr -> Expr)] Expr       handleValue = unnestRecords $ \usage inputExpr -> toConst $ flip appCombiner inputExpr <$> getCombiner usage -      getCombiner :: ParamUsage -> m (Bool, Expr)+      getCombiner :: ParamUsage Void -> m (Bool, Expr)       getCombiner = \case         IsParam ->+          pure (False, mkVar g)+        IsLParam ->           pure (False, mkVar f)         MentionsParam innerUsage ->           (isRightFold, ) . App recurseVar <$> mkCombinerExpr innerUsage+        MentionsParamBi theseInnerUsages ->+          (isRightFold, ) . appBirecurseExprs te <$> both mkCombinerExpr theseInnerUsages         IsRecord fields -> do           let foldFieldsOf = traverseFields handleValue fields           fmap (False, ) . usingLamIdent $ \lVar ->@@ -558,13 +758,13 @@       extractExprStartingWith :: Expr -> Const [m (Expr -> Expr)] Expr -> m Expr       extractExprStartingWith = consumeConst . if isRightFold then foldr ($) else foldl' (&) -    lam f . lam z <$> mkCasesForTraversal mn handleValue (extractExprStartingWith $ mkVar z) ctors+    lam f . applyWhen isBi (lam g) . lam z <$> mkCasesForTraversal mn handleValue (extractExprStartingWith $ mkVar z) ctors  foldMapOps :: forall m. Applicative m => TraversalOps m foldMapOps = TraversalOps { visitExpr = toConst, .. }   where-  appendVar = mkRef Prelude.identAppend-  memptyVar = mkRef Prelude.identMempty+  appendVar = mkRef Libs.I_append+  memptyVar = mkRef Libs.I_mempty    extractExpr :: Const [m Expr] Expr -> m Expr   extractExpr = consumeConst $ \case@@ -576,25 +776,37 @@    . MonadError MultipleErrors m   => MonadState CheckState m   => MonadSupply m-  => Qualified (ProperName 'ClassName)+  => Bool -- is there a left parameter (are we deriving Bitraversable)?+  -> Qualified (ProperName 'ClassName)   -> ModuleName   -> ProperName 'TypeName   -> m [(PSString, Expr)]-deriveTraversable nm mn tyConNm = do-  ctors <- validateParamsInTypeConstructors nm mn tyConNm-  traverseFun <- mkTraversal mn traverseVar traverseOps ctors-  sequenceFun <- usingLamIdent $ pure . App (App traverseVar identityVar)-  pure [(Traversable.traverse, traverseFun), (Traversable.sequence, sequenceFun)]+deriveTraversable isBi nm mn tyConNm = do+  ctors <- validateParamsInTypeConstructors nm mn tyConNm isBi traversableClasses Nothing+  traverseFun <- mkTraversal mn isBi traverseExprs absurd traverseOps ctors+  sequenceFun <- usingLamIdent $ pure . App (App (if isBi then App bitraverseVar identityVar else traverseVar) identityVar)+  pure+    [ (if isBi then Libs.S_bitraverse else Libs.S_traverse, traverseFun)+    , (if isBi then Libs.S_bisequence else Libs.S_sequence, sequenceFun)+    ]   where-  traverseVar = mkRef Traversable.identTraverse-  identityVar = mkRef Prelude.identIdentity+  traversableClasses = CovariantClasses Libs.Traversable Libs.Bitraversable+  traverseExprs = TraversalExprs+    { recurseVar = traverseVar+    , birecurseVar = bitraverseVar+    , lrecurseExpr = mkRef Libs.I_ltraverse+    , rrecurseExpr = mkRef Libs.I_rtraverse+    }+  traverseVar = mkRef Libs.I_traverse+  bitraverseVar = mkRef Libs.I_bitraverse+  identityVar = mkRef Libs.I_identity  traverseOps :: forall m. MonadSupply m => TraversalOps m traverseOps = TraversalOps { .. }   where-  pureVar = mkRef Prelude.identPure-  mapVar = mkRef Prelude.identMap-  applyVar = mkRef Prelude.identApply+  pureVar = mkRef Libs.I_pure+  mapVar = mkRef Libs.I_map+  applyVar = mkRef Libs.I_apply    visitExpr :: m Expr -> WriterT [(Ident, m Expr)] m Expr   visitExpr traversedExpr = do

@@ -7,6 +7,7 @@   , replaceTypeClassDictionaries   , newDictionaries   , entails+  , findDicts   ) where  import Prelude@@ -47,7 +48,7 @@ import Language.PureScript.Types import Language.PureScript.Label (Label(..)) import Language.PureScript.PSString (PSString, mkString, decodeString)-import qualified Language.PureScript.Constants.Prelude as C+import qualified Language.PureScript.Constants.Libs as C import qualified Language.PureScript.Constants.Prim as C  -- | Describes what sort of dictionary to generate for type class instances@@ -77,9 +78,9 @@   ReflectableString s -> Literal NullSourceSpan $ StringLiteral s   ReflectableBoolean b -> Literal NullSourceSpan $ BooleanLiteral b   ReflectableOrdering o -> Constructor NullSourceSpan $ case o of-    LT -> C.LT-    EQ -> C.EQ-    GT -> C.GT+    LT -> C.C_LT+    EQ -> C.C_EQ+    GT -> C.C_GT  -- | Extract the identifier of a named instance namedInstanceIdentifier :: Evidence -> Maybe (Qualified Ident)@@ -94,6 +95,9 @@                          (M.Map (Qualified (ProperName 'ClassName))                            (M.Map (Qualified Ident) (NonEmpty NamedDict))) +findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> QualifiedBy -> [TypeClassDict]+findDicts ctx cn = fmap (fmap NamedInstance) . foldMap NEL.toList . foldMap M.elems . (M.lookup cn <=< flip M.lookup ctx)+ -- | 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@@ -224,11 +228,8 @@     ctorModules (KindedType _ ty _) = ctorModules ty     ctorModules _ = Nothing -    findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> QualifiedBy -> [TypeClassDict]-    findDicts ctx cn = fmap (fmap NamedInstance) . foldMap NEL.toList . foldMap M.elems . (M.lookup cn <=< flip M.lookup ctx)-     valUndefined :: Expr-    valUndefined = Var nullSourceSpan (Qualified (ByModuleName C.Prim) (Ident C.undefined))+    valUndefined = Var nullSourceSpan C.I_undefined      solve :: SourceConstraint -> WriterT (Any, [(Ident, InstanceContext, SourceConstraint)]) (StateT InstanceContext m) Expr     solve = go 0 hints@@ -460,9 +461,9 @@     solveSymbolCompare :: [SourceType] -> Maybe [TypeClassDict]     solveSymbolCompare [arg0@(TypeLevelString _ lhs), arg1@(TypeLevelString _ rhs), _] =       let ordering = case compare lhs rhs of-                  LT -> C.orderingLT-                  EQ -> C.orderingEQ-                  GT -> C.orderingGT+                  LT -> C.LT+                  EQ -> C.EQ+                  GT -> C.GT           args' = [arg0, arg1, srcTypeConstructor ordering]       in Just [TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.SymbolCompare [] [] args' Nothing Nothing]     solveSymbolCompare _ = Nothing@@ -526,11 +527,11 @@         TypeLevelInt _ i -> pure (ReflectableInt i, tyInt)         TypeLevelString _ s -> pure (ReflectableString s, tyString)         TypeConstructor _ n-          | n == C.booleanTrue -> pure (ReflectableBoolean True, tyBoolean)-          | n == C.booleanFalse -> pure (ReflectableBoolean False, tyBoolean)-          | n == C.orderingLT -> pure (ReflectableOrdering LT, srcTypeConstructor C.Ordering)-          | n == C.orderingEQ -> pure (ReflectableOrdering EQ, srcTypeConstructor C.Ordering)-          | n == C.orderingGT -> pure (ReflectableOrdering GT, srcTypeConstructor C.Ordering)+          | n == C.True -> pure (ReflectableBoolean True, tyBoolean)+          | n == C.False -> pure (ReflectableBoolean False, tyBoolean)+          | n == C.LT -> pure (ReflectableOrdering LT, srcTypeConstructor C.Ordering)+          | n == C.EQ -> pure (ReflectableOrdering EQ, srcTypeConstructor C.Ordering)+          | n == C.GT -> pure (ReflectableOrdering GT, srcTypeConstructor C.Ordering)         _ -> Nothing       pure [TypeClassDictionaryInScope Nothing 0 (ReflectableInstance ref) [] C.Reflectable [] [] [typeLevel, typ] Nothing Nothing]     solveReflectable _ = Nothing@@ -554,9 +555,9 @@     solveIntCompare :: InstanceContext -> [SourceType] -> Maybe [TypeClassDict]     solveIntCompare _ [arg0@(TypeLevelInt _ a), arg1@(TypeLevelInt _ b), _] =       let ordering = case compare a b of-            EQ -> C.orderingEQ-            LT -> C.orderingLT-            GT -> C.orderingGT+            EQ -> C.EQ+            LT -> C.LT+            GT -> C.GT           args' = [arg0, arg1, srcTypeConstructor ordering]       in pure [TypeClassDictionaryInScope Nothing 0 EmptyClassInstance [] C.IntCompare [] [] args' Nothing Nothing]     solveIntCompare ctx args@[a, b, _] = do

@@ -373,8 +373,8 @@  -- | A canonical constraint of the form @Coercible tv1 ty1@ can rewrite the -- right hand side of an irreducible constraint of the form @Coercible tv2 ty2@--- by substituting @ty1@ for every occurence of @tv1@ at representational and--- phantom role in @ty2@. Nominal occurences are left untouched.+-- by substituting @ty1@ for every occurrence of @tv1@ at representational and+-- phantom role in @ty2@. Nominal occurrences are left untouched. rewrite :: Environment -> (SourceType, SourceType) -> SourceType -> Writer Any SourceType rewrite env (Skolem _ _ _ s1 _, ty1) | not $ occurs s1 ty1 = go where   go (Skolem _ _ _ s2 _) | s1 == s2 = tell (Any True) $> ty1@@ -506,7 +506,7 @@     --     -- yield the wanted @Coercible (N Maybe a) (N Maybe b)@ which we cannot     -- decompose because the second parameter of @N@ is nominal. On the other-    -- hand, unwraping on both sides yields @Coercible (Maybe a) (Maybe b)@+    -- hand, unwrapping on both sides yields @Coercible (Maybe a) (Maybe b)@     -- which we can then decompose to @Coercible a b@ and discharge with the     -- given.     <|> canonNewtypeLeft env a b@@ -601,7 +601,7 @@           throwError . errorMessage $ TypesDoNotUnify (rowFromList rl1) (rowFromList rl2)   | otherwise = empty --- | Unwraping a newtype can fails in two ways:+-- | Unwrapping a newtype can fails in two ways: data UnwrapNewtypeError   = CannotUnwrapInfiniteNewtypeChain   -- ^ The newtype might wrap an infinite newtype chain. We may think that this@@ -620,7 +620,7 @@   --   -- yield a wanted @Coercible (N a) (N b)@ that we can decompose to   -- @Coercible a b@ then discharge with the given if the newtype-  -- unwraping rules do not apply.+  -- unwrapping rules do not apply.   | CannotUnwrapConstructor   -- ^ The constructor may not be in scope or may not belong to a newtype. @@ -709,7 +709,7 @@     _ -> False  -- | Constraints of the form @Coercible (N a_0 .. a_n) b@ yield a constraint--- @Coercible a b@ if unwraping the newtype yields @a@.+-- @Coercible a b@ if unwrapping the newtype yields @a@. canonNewtypeLeft   :: MonadState CheckState m   => MonadWriter [ErrorMessageHint] m@@ -724,7 +724,7 @@     Right a' -> pure . Canonicalized $ S.singleton (a', b)  -- | Constraints of the form @Coercible a (N b_0 .. b_n)@ yield a constraint--- @Coercible a b@ if unwraping the newtype yields @b@.+-- @Coercible a b@ if unwrapping the newtype yields @b@. canonNewtypeRight   :: MonadState CheckState m   => MonadWriter [ErrorMessageHint] m@@ -779,7 +779,6 @@ -- @D@ is not a newtype, yield constraints on their arguments. canonDecomposition   :: MonadError MultipleErrors m-  => MonadState CheckState m   => Environment   -> SourceType   -> SourceType@@ -797,7 +796,6 @@ -- newtypes, are insoluble. canonDecompositionFailure   :: MonadError MultipleErrors m-  => MonadState CheckState m   => Environment   -> SourceType   -> SourceType@@ -829,7 +827,7 @@ -- Decomposing a given @Coercible (Const a a) (Const a b)@ constraint to -- @Coercible a b@ when @MkConst@ is out of scope would let us coerce arbitrary -- types in modules where @MkConst@ is imported, because the given is easily--- satisfied with the newtype unwraping rules.+-- satisfied with the newtype unwrapping rules. -- -- Moreover we do not decompose wanted constraints if they could be discharged -- by a given constraint.@@ -847,7 +845,6 @@ -- to discharge it with the given. canonNewtypeDecomposition   :: MonadError MultipleErrors m-  => MonadState CheckState m   => Environment   -> Maybe [(SourceType, SourceType, SourceType)]   -> SourceType

@@ -46,18 +46,18 @@ solveRelation :: forall a. Ord a => Context a -> a -> a -> Maybe PSOrdering solveRelation context lhs rhs =   if lhs == rhs then-    pure P.orderingEQ+    pure P.EQ   else do     let (graph, search) = inequalities     lhs' <- search lhs     rhs' <- search rhs     case (G.path graph lhs' rhs', G.path graph rhs' lhs') of       (True, True) ->-        pure P.orderingEQ+        pure P.EQ       (True, False) ->-        pure P.orderingLT+        pure P.LT       (False, True) ->-        pure P.orderingGT+        pure P.GT       _ ->         Nothing   where@@ -79,9 +79,9 @@ mkRelation :: P.Type a -> P.Type a -> P.Type a -> Maybe (Relation (P.Type a)) mkRelation lhs rhs rel = case rel of   P.TypeConstructor _ ordering-    | ordering == P.orderingEQ -> pure $ Equal lhs rhs-    | ordering == P.orderingLT -> pure $ LessThan lhs rhs-    | ordering == P.orderingGT -> pure $ LessThan rhs lhs+    | ordering == P.EQ -> pure $ Equal lhs rhs+    | ordering == P.LT -> pure $ LessThan lhs rhs+    | ordering == P.GT -> pure $ LessThan rhs lhs   _ ->     Nothing 

@@ -910,7 +910,7 @@   checkQuantification finalTy   checkValidKind finalTy   where-  -- When expanding type synoyms and generalizing, we need to generate more+  -- When expanding type synonyms and generalizing, we need to generate more   -- unique names so that they don't clash or shadow other names, or can   -- be referenced (easily).   freshVar arg = (arg <>) . T.pack . show <$> fresh

@@ -365,7 +365,7 @@     "ParensInType" -> do       b <- contents       ParensInType a <$> go b-    -- Backwards compatability for kinds+    -- Backwards compatibility for kinds     "KUnknown" ->       TUnknown a <$> contents     "Row" ->

@@ -1,6 +1,6 @@ # Please update Haskell image versions under .github/workflows/ci.yml together to use the same GHC version # (or the CI build will fail)-resolver: nightly-2022-06-09+resolver: nightly-2022-11-12 pvp-bounds: both packages: - '.'

@@ -6,13 +6,14 @@ import           Language.PureScript.Ide.Filter import           Language.PureScript.Ide.Filter.Declaration as D import           Language.PureScript.Ide.Types+import           Language.PureScript.Ide.Imports import           Language.PureScript.Ide.Test as T import qualified Language.PureScript as P import           Test.Hspec  type Module = (P.ModuleName, [IdeDeclarationAnn]) -moduleA, moduleB, moduleC, moduleD, moduleE, moduleF, moduleG, moduleH, moduleI :: Module+moduleA, moduleB, moduleC, moduleD, moduleE, moduleF, moduleG, moduleH, moduleI, moduleDCtors :: Module moduleA = (P.moduleNameFromString "Module.A", [T.ideValue "function1" Nothing]) moduleB = (P.moduleNameFromString "Module.B", [T.ideValue "data1" Nothing]) moduleC = (P.moduleNameFromString "Module.C", [T.ideType "List" Nothing []])@@ -22,10 +23,14 @@ moduleG = (P.moduleNameFromString "Module.G", [T.ideTypeClass "MyClass" P.kindType []]) moduleH = (P.moduleNameFromString "Module.H", [T.ideValueOp "<$>" (P.Qualified P.ByNullSourcePos (Left "")) 0 Nothing Nothing]) moduleI = (P.moduleNameFromString "Module.I", [T.ideTypeOp "~>" (P.Qualified P.ByNullSourcePos "") 0 Nothing Nothing])+moduleDCtors = (P.moduleNameFromString "Module.WithDC", [T.ideType "Foo" Nothing [(P.ProperName "A", P.tyString), (P.ProperName "B", P.tyString)] ])  modules :: ModuleMap [IdeDeclarationAnn] modules = Map.fromList [moduleA, moduleB] +allModules :: ModuleMap [IdeDeclarationAnn]+allModules = Map.fromList [moduleA, moduleB,moduleC,moduleD,moduleE,moduleF,moduleG,moduleH,moduleI,moduleDCtors]+ runEq :: Text -> [Module] runEq s = Map.toList (applyFilters [exactFilter s] modules) @@ -41,6 +46,20 @@ runDeclaration :: [D.DeclarationType] -> [Module] -> [Module] runDeclaration decls = Map.toList . applyFilters [declarationTypeFilter (Set.fromList decls)] . Map.fromList +runDependency :: [Text] -> [Module]+runDependency = runDependency' "Whatever"++runDependency' :: Text -> [Text] -> [Module]+runDependency' currentModuleName imports = Map.toList $ applyFilters [dependencyFilter Nothing (P.ModuleName currentModuleName) (testParseImports currentModuleName imports)] allModules++runDependencyQualified :: Text -> [Text] -> [Module]+runDependencyQualified qualifier imports = Map.toList $ applyFilters [dependencyFilter (Just $ P.ModuleName qualifier) (P.ModuleName "Whatever") (testParseImports "Whatever" imports)] allModules++testParseImports :: Text -> [Text] -> [Import]+testParseImports currentModuleName imports = either (const []) (\(_, _, x, _) -> x) $ sliceImportSection moduleLines+  where+  moduleLines = "module " <> currentModuleName <> " where" : (imports <> [ "", "blah = 42" ])+ spec :: Spec spec = do   describe "equality Filter" $ do@@ -130,3 +149,45 @@     it "extracts modules by filtering `value`, and `valueoperator` declarations" $       runDeclaration [D.Value, D.ValueOperator]         [moduleA, moduleB, moduleD, moduleG, moduleE, moduleH] `shouldBe` [moduleA, moduleB, moduleH]+  describe "dependencyFilter" $ do+    describe "import types" $ do+      it "filters by implicit imports" $ do+        runDependency ["import Module.A", "import Module.C"] `shouldBe` [moduleA, moduleC]+      it "filters by matching explicit value import" $ do+        runDependency ["import Module.A (function1)"] `shouldBe` [moduleA]+      it "filters by matching explicit value import from correct module" $ do+        runDependency ["import Module.B (function1)"] `shouldBe` []+      it "filters not matching explicit value import" $ do+        runDependency ["import Module.A (function2)"] `shouldBe` []+      it "filters out names in hiding import" $ do+        runDependency ["import Module.A hiding (function1)"] `shouldBe` []+      it "doesn't filter out not matching names in hiding import" $ do+        runDependency ["import Module.A hiding (nonsense)"] `shouldBe` [moduleA]+      it "filters by containing module" $ do+        runDependency' "Module.A" ["import Module.Blah"] `shouldBe` [moduleA]+    describe "declaration types" $ do+      it "matches type" $ do+        runDependency ["import Module.C (List)"] `shouldBe` [moduleC]+      it "includes data constructor with (..)" $ do+        runDependency ["import Module.F (TypeA(..))"] `shouldBe` [moduleF]+      it "includes data constructor explicitly listed" $ do+        runDependency ["import Module.F (TypeA(DtorA))"] `shouldBe` [moduleF]+      it "does not include data constructor not explicitly listed" $ do+        runDependency ["import Module.F (TypeA(BogusOtherConstructor))"] `shouldBe` []+      it "does not include data constructor when only the type is imported" $ do+        runDependency ["import Module.F (TypeA)"] `shouldBe` []+      it "includes synonym" $ do+        runDependency ["import Module.E (SFType)"] `shouldBe` [moduleE]+      it "includes typeclass" $ do+        runDependency ["import Module.G (class MyClass)"] `shouldBe` [moduleG]+      it "includes value op" $ do+        runDependency ["import Module.H ((<$>))"] `shouldBe` [moduleH]+      it "includes type op" $ do+        runDependency ["import Module.I (type (~>))"] `shouldBe` [moduleI]+    describe "qualifiers" $ do+      it "includes single qualified import and not unqualified things" $ do+        runDependencyQualified "AA" [ "import Module.A as AA", "import Module.C"] `shouldBe` [moduleA]+      it "includes multiple qualified imports" $ do+        runDependencyQualified "Combined.Thing" [ "import Module.A as Combined.Thing", "import Module.C as Combined.Thing", "import Module.F"] `shouldBe` [moduleA, moduleC]+      it "doesn't include qualified import when qualifier not specified" $ do+        runDependency [ "import Module.AA as A"] `shouldBe` []

@@ -8,6 +8,7 @@ import           Language.PureScript.Ide.Command as Command import           Language.PureScript.Ide.Error import           Language.PureScript.Ide.Imports+import           Language.PureScript.Ide.Imports.Actions import           Language.PureScript.Ide.Filter (moduleFilter) import qualified Language.PureScript.Ide.Test as Test import           Language.PureScript.Ide.Types

@@ -166,7 +166,7 @@           moduleContent2 = moduleContent1 <> "\ny :: Int\ny = 1"           optsWithDocs = P.defaultOptions { P.optionsCodegenTargets = Set.fromList [P.JS, P.Docs] }           go opts = compileWithOptions opts [modulePath] >>= assertSuccess-          oneSecond = 10^(6::Int) -- microseconds.+          oneSecond = 10 ^ (6::Int) -- microseconds.        writeFileWithTimestamp modulePath timestampA moduleContent1       go optsWithDocs `shouldReturn` moduleNames ["Module"]@@ -184,7 +184,7 @@           moduleContent2 = moduleContent1 <> "\ny :: Int\ny = 1"           optsCorefnOnly = P.defaultOptions { P.optionsCodegenTargets = Set.singleton P.CoreFn }           go opts = compileWithOptions opts [modulePath] >>= assertSuccess-          oneSecond = 10^(6::Int) -- microseconds.+          oneSecond = 10 ^ (6::Int) -- microseconds.        writeFileWithTimestamp modulePath timestampA moduleContent1       go optsCorefnOnly `shouldReturn` moduleNames ["Module"]

@@ -2,7 +2,7 @@ in module [33mMain[0m at tests/purs/failing/2567.purs:7:8 - 7:67 (line 7, column 8 - line 7, column 67) -  A custom type error occurred while solving type class constraints:+  Custom error:      This constraint should be checked 

@@ -0,0 +1,16 @@+Error found:+in module [33mBifunctorInstance1[0m+at tests/purs/failing/BifunctorInstance1.purs:10:1 - 10:31 (line 10, column 1 - line 10, column 31)++  One or more type variables are in positions that prevent [33mBifunctor[0m from being derived.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, that their variance matches the variance of [33mBifunctor[0m, and that those type constructors themselves have instances of [33mData.Functor.Functor[0m, [33mData.Bifunctor.Bifunctor[0m, [33mData.Functor.Contravariant.Contravariant[0m, or [33mData.Profunctor.Profunctor[0m.++  tests/purs/failing/BifunctorInstance1.purs:+  [90m    8[0m [33m[0m+  [90m    9[0m [33mdata Test a b = Test (Tuple (Predicate [7ma[27m) (Predicate [7mb[27m)) (Tuple a b)[0m+  [90m   10[0m [33mderive instance Bifunctor Test[0m+++See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information,+or to contribute content related to this error.+

@@ -0,0 +1,10 @@+-- @shouldFailWith CannotDeriveInvalidConstructorArg+module BifunctorInstance1 where++import Prelude+import Data.Bifunctor (class Bifunctor)+import Data.Predicate (Predicate)+import Data.Tuple (Tuple)++data Test a b = Test (Tuple (Predicate a) (Predicate b)) (Tuple a b)+derive instance Bifunctor Test

@@ -0,0 +1,16 @@+Error found:+in module [33mContravariantInstance1[0m+at tests/purs/failing/ContravariantInstance1.purs:9:1 - 9:35 (line 9, column 1 - line 9, column 35)++  One or more type variables are in positions that prevent [33mContravariant[0m from being derived.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, that their variance matches the variance of [33mContravariant[0m, and that those type constructors themselves have instances of [33mData.Functor.Functor[0m, [33mData.Bifunctor.Bifunctor[0m, [33mData.Functor.Contravariant.Contravariant[0m, or [33mData.Profunctor.Profunctor[0m.++  tests/purs/failing/ContravariantInstance1.purs:+  [90m    6[0m [33m[0m+  [90m    7[0m [33mnewtype Test a = Test (Predicate (Predicate [7ma[27m))[0m+  [90m    8[0m [33m[0m+++See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information,+or to contribute content related to this error.+

@@ -0,0 +1,9 @@+-- @shouldFailWith CannotDeriveInvalidConstructorArg+module ContravariantInstance1 where++import Data.Functor.Contravariant (class Contravariant)+import Data.Predicate (Predicate)++newtype Test a = Test (Predicate (Predicate a))++derive instance Contravariant Test

@@ -1,8 +1,8 @@ Error found: in module [33mMain[0m-at tests/purs/failing/DuplicateDeclarationsInLet.purs:6:7 - 6:8 (line 6, column 7 - line 6, column 8)+at tests/purs/failing/DuplicateDeclarationsInLet.purs:9:3 - 9:14 (line 9, column 3 - line 9, column 14) -  The same name was used more than once in a let binding.+  The name [33ma[0m was defined multiple times in a binding group   See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information,

@@ -1,8 +1,6 @@ -- @shouldFailWith OverlappingNamesInLet module Main where -import Prelude- foo = a   where   a :: Number

@@ -0,0 +1,10 @@+Error found:+in module [33mMain[0m+at tests/purs/failing/DuplicateDeclarationsInLet2.purs:10:3 - 10:24 (line 10, column 3 - line 10, column 24)++  The name [33minterrupted[0m was defined multiple times in a binding group+++See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information,+or to contribute content related to this error.+

@@ -0,0 +1,10 @@+-- @shouldFailWith OverlappingNamesInLet+module Main where++foo = interrupted+  where+  interrupted true = 1++  interrupter = 2++  interrupted false = 3

@@ -0,0 +1,22 @@+Error 1 of 2:++  in module [33mMain[0m+  at tests/purs/failing/DuplicateDeclarationsInLet3.purs:9:3 - 9:11 (line 9, column 3 - line 9, column 11)++    The name [33ma[0m was defined multiple times in a binding group+++  See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information,+  or to contribute content related to this error.++Error 2 of 2:++  in module [33mMain[0m+  at tests/purs/failing/DuplicateDeclarationsInLet3.purs:16:3 - 16:24 (line 16, column 3 - line 16, column 24)++    The name [33minterrupted[0m was defined multiple times in a binding group+++  See https://github.com/purescript/documentation/blob/master/errors/OverlappingNamesInLet.md for more information,+  or to contribute content related to this error.+

@@ -0,0 +1,16 @@+-- @shouldFailWith OverlappingNamesInLet+-- @shouldFailWith OverlappingNamesInLet+module Main where++-- Should see separate errors for `a` and `interrupted`+foo = interrupter + a+  where+  a = 0+  a :: Int+  a = 0++  interrupted true = 1++  interrupter = 2++  interrupted false = 3

@@ -3,7 +3,7 @@ at tests/purs/failing/FoldableInstance10.purs:11:1 - 11:30 (line 11, column 1 - line 11, column 30)    One or more type variables are in positions that prevent [33mFoldable[0m from being derived.-  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mFoldable[0m.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mData.Foldable.Foldable[0m or [33mData.Bifoldable.Bifoldable[0m.    tests/purs/failing/FoldableInstance10.purs:   [90m    9[0m [33m[0m

@@ -2,22 +2,15 @@ in module [33mFoldableInstance4[0m at tests/purs/failing/FoldableInstance4.purs:8:1 - 8:27 (line 8, column 1 - line 8, column 27) -  No type class instance was found for-  [33m                                      [0m-  [33m  Data.Foldable.Foldable (Function t3)[0m-  [33m                                      [0m-  The instance head contains unknown type variables. Consider adding a type annotation.+  One or more type variables are in positions that prevent [33mFoldable[0m from being derived.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mData.Foldable.Foldable[0m or [33mData.Bifoldable.Bifoldable[0m. -while applying a function [33mfoldl[0m-  of type [33mFoldable t0 => (t1 -> t2 -> t1) -> t1 -> t0 t2 -> t1[0m-  to argument [33m$f1[0m-while inferring the type of [33mfoldl $f1[0m+  tests/purs/failing/FoldableInstance4.purs:+  [90m    6[0m [33m[0m+  [90m    7[0m [33mdata T a = T (forall t. Show t => t -> [7ma[27m)[0m+  [90m    8[0m [33mderive instance Foldable T[0m -where [33mt0[0m is an unknown type-      [33mt2[0m is an unknown type-      [33mt1[0m is an unknown type-      [33mt3[0m is an unknown type -See https://github.com/purescript/documentation/blob/master/errors/NoInstanceFound.md for more information,+See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information, or to contribute content related to this error. 

@@ -1,4 +1,4 @@--- @shouldFailWith NoInstanceFound+-- @shouldFailWith CannotDeriveInvalidConstructorArg module FoldableInstance4 where  import Prelude

@@ -1,16 +0,0 @@-Error found:-in module [33mFoldableInstance5[0m-at tests/purs/failing/FoldableInstance5.purs:9:1 - 9:30 (line 9, column 1 - line 9, column 30)--  One or more type variables are in positions that prevent [33mFoldable[0m from being derived.-  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mFoldable[0m.--  tests/purs/failing/FoldableInstance5.purs:-  [90m    7[0m [33m[0m-  [90m    8[0m [33mdata Test a = Test (Tuple [7ma[27m Int)[0m-  [90m    9[0m [33mderive instance Foldable Test[0m---See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information,-or to contribute content related to this error.-

@@ -1,9 +0,0 @@--- @shouldFailWith CannotDeriveInvalidConstructorArg-module FoldableInstance5 where--import Prelude-import Data.Foldable (class Foldable)-import Data.Tuple (Tuple(..))--data Test a = Test (Tuple a Int)-derive instance Foldable Test

@@ -3,7 +3,7 @@ at tests/purs/failing/FoldableInstance6.purs:8:1 - 8:30 (line 8, column 1 - line 8, column 30)    One or more type variables are in positions that prevent [33mFoldable[0m from being derived.-  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mFoldable[0m.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mData.Foldable.Foldable[0m or [33mData.Bifoldable.Bifoldable[0m.    tests/purs/failing/FoldableInstance6.purs:   [90m    6[0m [33m[0m

@@ -1,16 +0,0 @@-Error found:-in module [33mFoldableInstance6[0m-at tests/purs/failing/FoldableInstance7.purs:9:1 - 9:30 (line 9, column 1 - line 9, column 30)--  One or more type variables are in positions that prevent [33mFoldable[0m from being derived.-  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mFoldable[0m.--  tests/purs/failing/FoldableInstance7.purs:-  [90m    7[0m [33m[0m-  [90m    8[0m [33mdata Test a = Test (Tuple [7ma[27m a)[0m-  [90m    9[0m [33mderive instance Foldable Test[0m---See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information,-or to contribute content related to this error.-

@@ -1,9 +0,0 @@--- @shouldFailWith CannotDeriveInvalidConstructorArg-module FoldableInstance6 where--import Prelude-import Data.Tuple (Tuple(..))-import Data.Foldable (class Foldable)--data Test a = Test (Tuple a a)-derive instance Foldable Test

@@ -3,11 +3,11 @@ at tests/purs/failing/FoldableInstance8.purs:8:1 - 8:34 (line 8, column 1 - line 8, column 34)    One or more type variables are in positions that prevent [33mFoldable[0m from being derived.-  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mFoldable[0m.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mData.Foldable.Foldable[0m or [33mData.Bifoldable.Bifoldable[0m.    tests/purs/failing/FoldableInstance8.purs:   [90m    6[0m [33m[0m-  [90m    7[0m [33mdata Test f a = Test (f [7ma[27m a)[0m+  [90m    7[0m [33mdata Test f a = Test (f [7ma[27m [7ma[27m)[0m   [90m    8[0m [33mderive instance Foldable (Test f)[0m  

@@ -3,13 +3,13 @@ at tests/purs/failing/FoldableInstance9.purs:53:1 - 53:38 (line 53, column 1 - line 53, column 38)    One or more type variables are in positions that prevent [33mFoldable[0m from being derived.-  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mFoldable[0m.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, and that those type constructors themselves have instances of [33mData.Foldable.Foldable[0m or [33mData.Bifoldable.Bifoldable[0m.    tests/purs/failing/FoldableInstance9.purs:   [90m   15[0m [33mdata Test f g h a[0m-  [90m   16[0m [33m  = Test1 (f [7ma[27m [7ma[27m a) (f Int [7ma[27m a) (f [7ma[27m [7ma[27m Int) (f Int [7ma[27m Int) (f Int Int Int)[0m-  [90m   17[0m [33m  | Test2 { all :: f [7ma[27m [7ma[27m a[0m-  [90m   18[0m [33m          , rights :: f Int [7ma[27m a[0m+  [90m   16[0m [33m  = Test1 (f [7ma[27m [7ma[27m [7ma[27m) (f Int [7ma[27m [7ma[27m) (f [7ma[27m [7ma[27m Int) (f Int [7ma[27m Int) (f Int Int Int)[0m+  [90m   17[0m [33m  | Test2 { all :: f [7ma[27m [7ma[27m [7ma[27m[0m+  [90m   18[0m [33m          , rights :: f Int [7ma[27m [7ma[27m[0m   [90m   19[0m [33m          , lefts :: f [7ma[27m [7ma[27m Int[0m   [90m   20[0m [33m          , middle :: f Int [7ma[27m Int[0m   [90m   21[0m [33m          , none :: f Int Int Int[0m@@ -20,7 +20,9 @@   [90m   26[0m [33m            , lefts :: f [7ma[27m [7ma[27m Int[0m   [90m   27[0m [33m            , middle :: f Int [7ma[27m Int[0m   [90m   28[0m [33m            , none :: f Int Int Int[0m-  [90m  ...[0m+  [90m   29[0m [33m            }[0m+  [90m   30[0m [33m            [7ma[27m)[0m+  [90m   31[0m [33m  | Test4 (h[0m   [90m   32[0m [33m            { nested1 ::[0m   [90m   33[0m [33m                { all :: f [7ma[27m [7ma[27m [7ma[27m[0m   [90m   34[0m [33m                , rights :: f Int [7ma[27m [7ma[27m[0m@@ -37,10 +39,10 @@   [90m   46[0m [33m                  }[0m   [90m   47[0m [33m                  [7ma[27m[0m   [90m   48[0m [33m            }[0m-  [90m   49[0m [33m            a)[0m+  [90m   49[0m [33m            [7ma[27m)[0m   [90m   50[0m [33m  | Test5 (Rec f [7ma[27m)[0m-  [90m   51[0m [33m  | Test6 (g (Rec f [7ma[27m) a)[0m-  [90m   52[0m [33m  | Test7 (h { nested1 :: Rec f [7ma[27m, nested2 :: g (Rec f [7ma[27m) [7ma[27m } a)[0m+  [90m   51[0m [33m  | Test6 (g (Rec f [7ma[27m) [7ma[27m)[0m+  [90m   52[0m [33m  | Test7 (h { nested1 :: Rec f [7ma[27m, nested2 :: g (Rec f [7ma[27m) [7ma[27m } [7ma[27m)[0m   [90m   53[0m [33mderive instance Foldable (Test f g h)[0m  

@@ -0,0 +1,16 @@+Error found:+in module [33mFunctorInstance1[0m+at tests/purs/failing/FunctorInstance1.purs:8:1 - 8:29 (line 8, column 1 - line 8, column 29)++  One or more type variables are in positions that prevent [33mFunctor[0m from being derived.+  To derive this class, make sure that these variables are only used as the final arguments to type constructors, that their variance matches the variance of [33mFunctor[0m, and that those type constructors themselves have instances of [33mData.Functor.Functor[0m, [33mData.Bifunctor.Bifunctor[0m, [33mData.Functor.Contravariant.Contravariant[0m, or [33mData.Profunctor.Profunctor[0m.++  tests/purs/failing/FunctorInstance1.purs:+  [90m    6[0m [33m[0m+  [90m    7[0m [33mdata Test a = Test (Predicate [7ma[27m)[0m+  [90m    8[0m [33mderive instance Functor Test[0m+++See https://github.com/purescript/documentation/blob/master/errors/CannotDeriveInvalidConstructorArg.md for more information,+or to contribute content related to this error.+

@@ -0,0 +1,8 @@+-- @shouldFailWith CannotDeriveInvalidConstructorArg+module FunctorInstance1 where++import Prelude+import Data.Predicate (Predicate)++data Test a = Test (Predicate a)+derive instance Functor Test

@@ -2,7 +2,7 @@ in module [33mMain[0m at tests/purs/failing/ProgrammablePolykindedTypeErrorsTypeString.purs:23:7 - 23:17 (line 23, column 7 - line 23, column 17) -  A custom type error occurred while solving type class constraints:+  Custom error:      Don't want to show Just @Type String because. 

@@ -2,7 +2,7 @@ in module [33mMain[0m at tests/purs/failing/ProgrammableTypeErrors.purs:17:13 - 17:27 (line 17, column 13 - line 17, column 27) -  A custom type error occurred while solving type class constraints:+  Custom error:      Cannot show functions 

@@ -2,7 +2,7 @@ in module [33mMain[0m at tests/purs/failing/ProgrammableTypeErrorsTypeString.purs:24:9 - 24:24 (line 24, column 9 - line 24, column 24) -  A custom type error occurred while solving type class constraints:+  Custom error:      Don't want to show MyType Int because. 

@@ -0,0 +1,26 @@+module Main where++import Prelude++import Data.Bifoldable (class Bifoldable)+import Data.Bifunctor (class Bifunctor)+import Data.Bitraversable (class Bitraversable)+import Data.Predicate (Predicate)+import Data.Tuple (Tuple)+import Effect.Console (log)++data Test f a b+  = Test0+  | Test1 (Array a) b+  | Test2 Int (forall a. Array a -> Array a)+  | Test3 Int (f a b) (f a Int) (f Int b)+  | Test4 (Array (Tuple a Int)) (Tuple b Int)+  | Test5 { nested :: Array { x :: f { a :: a } { b :: b } } }+derive instance Bifunctor f => Bifunctor (Test f)+derive instance Bifoldable f => Bifoldable (Test f)+derive instance Bitraversable f => Bitraversable (Test f)++data FromProAndContra a b = FromProAndContra (Predicate (a -> Int)) (Predicate b -> Int)+derive instance Bifunctor FromProAndContra++main = log "Done"

@@ -0,0 +1,20 @@+module Main where++import Prelude++import Data.Functor.Contravariant (class Contravariant)+import Data.Predicate (Predicate)+import Data.Tuple (Tuple)+import Effect.Console (log)++data Test f a+  = Test0+  | Test1 (Predicate a)+  | Test2 (Predicate (Predicate (Predicate a)))+  | Test3 Int (forall a. Array a -> Array a)+  | Test4 Int (f a)+  | Test5 (Array (a -> Int)) (Tuple (Predicate a) Int)+  | Test6 { nested :: Array { x :: f { a :: a } } }+derive instance Contravariant f => Contravariant (Test f)++main = log "Done"

@@ -0,0 +1,18 @@+module Main where++import Prelude++import Data.Foldable (class Foldable)+import Data.Traversable (class Traversable)+import Data.Tuple (Tuple)+import Effect.Console (log)++data Test a+  = Test1 (Tuple a Int)+  | Test2 (Tuple (Array a) a)+  | Test3 { x :: Tuple { a :: a } Int, y :: Tuple { a :: Array a } { a :: a } }+derive instance Functor Test+derive instance Foldable Test+derive instance Traversable Test++main = log "Done"

@@ -0,0 +1,13 @@+module Main where++import Prelude++import Data.Predicate (Predicate)+import Effect.Console (log)++data Test a+  = Test1 (Predicate (Predicate a))+  | Test2 { x :: Predicate { y :: Predicate a } }+derive instance Functor Test++main = log "Done"

@@ -0,0 +1,16 @@+module Main where++-- Note that Data.Profunctor is not in the dependencies of any types imported+-- here. The package that contains that module must be a dependency of the test+-- project.++import Prelude++import Effect.Console (log)++data Test a+  = Test1 ((Array a -> Int) -> Int)+  | Test2 { f :: ({ a :: a } -> Int) -> Int }+derive instance Functor Test++main = log "Done"

@@ -0,0 +1,46 @@+module Main where++import Prelude++import Data.Bifunctor (class Bifunctor)+import Data.Profunctor (class Profunctor)+import Effect (Effect)+import Effect.Console (log)+import Test.Assert (assert')++newtype MonoAndBi a b = MonoAndBi (Effect Unit)+derive instance Functor (MonoAndBi a)+instance Bifunctor MonoAndBi where+  bimap _ _ _ = MonoAndBi (assert' "Bifunctor instance was used but the Functor instance was expected" false)++newtype Test1 a = Test1 (MonoAndBi Int a)+derive instance Functor Test1++data ExclusivelyBi a b+derive instance Bifunctor ExclusivelyBi++newtype Test2 a = Test2 (ExclusivelyBi Int a)+derive instance Functor Test2++newtype MonoAndPro a b = MonoAndPro (Effect Unit)+derive instance Functor (MonoAndPro a)+instance Profunctor MonoAndPro where+  dimap _ _ _ = MonoAndPro (assert' "Profunctor instance was used but the Functor instance was expected" false)++newtype Test3 a = Test3 (MonoAndPro Int a)+derive instance Functor Test3++data ExclusivelyPro a b+derive instance Profunctor ExclusivelyPro++newtype Test4 a = Test4 (ExclusivelyPro Int a)+derive instance Functor Test4++main = do+  let t = Test1 (MonoAndBi (pure unit))+  let Test1 (MonoAndBi result1) = map identity t+  result1+  let t = Test3 (MonoAndPro (pure unit))+  let Test3 (MonoAndPro result3) = map identity t+  result3+  log "Done"

@@ -0,0 +1,19 @@+module Main where++import Prelude++import Data.Predicate (Predicate)+import Data.Profunctor (class Profunctor)+import Data.Tuple (Tuple)+import Effect.Console (log)++data Test f a b+  = Test0+  | Test1 (Predicate a) b+  | Test2 Int (forall a. Array a -> Array a)+  | Test3 Int (f a b) (f a Int) (f Int b)+  | Test4 (Array (a -> Int)) (Tuple b Int)+  | Test5 { nested :: Array { x :: f { a :: a } { b :: b } } }+derive instance Profunctor f => Profunctor (Test f)++main = log "Done"