packages feed

hls-refactor-plugin (empty) → 1.0.0.0

raw patch · 124 files changed

+9711/−0 lines, 124 filesdep +aesondep +asyncdep +base

Dependencies added: aeson, async, base, bytestring, containers, data-default, deepseq, directory, dlist, extra, filepath, ghc, ghc-boot, ghc-exactprint, ghcide, ghcide-test-utils, hls-graph, hls-plugin-api, hls-refactor-plugin, hls-test-utils, lens, lsp, lsp-test, lsp-types, mtl, network-uri, parser-combinators, regex-tdfa, retrie, shake, syb, tasty, tasty-expected-failure, tasty-hunit, tasty-rerun, text, text-rope, time, transformers, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,201 @@+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ hls-refactor-plugin.cabal view
@@ -0,0 +1,124 @@+cabal-version:      3.0+name:               hls-refactor-plugin+version:            1.0.0.0+synopsis:           Exactprint refactorings for Haskell Language Server+description:+  Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>++license:            Apache-2.0+license-file:       LICENSE+author:             The Haskell IDE Team+copyright:          The Haskell IDE Team+maintainer:         zubin.duggal@gmail.com+category:           Development+build-type:         Simple+extra-source-files:+  LICENSE+  test/data/**/*.hs+  test/data/**/*.yaml++library+  if impl(ghc >= 9.3)+    buildable: False+  else+    buildable: True+  exposed-modules:  Development.IDE.GHC.ExactPrint+                    Development.IDE.GHC.Compat.ExactPrint+                    Development.IDE.Plugin.CodeAction+                    Development.IDE.Plugin.CodeAction.Util+                    Development.IDE.GHC.Dump+  other-modules:    Development.IDE.Plugin.CodeAction.Args+                    Development.IDE.Plugin.CodeAction.ExactPrint+                    Development.IDE.Plugin.CodeAction.PositionIndexed+  default-extensions:+    BangPatterns+    CPP+    DataKinds+    DeriveGeneric+    DerivingStrategies+    DerivingVia+    DuplicateRecordFields+    ExplicitNamespaces+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GeneralizedNewtypeDeriving+    LambdaCase+    NamedFieldPuns+    OverloadedStrings+    PatternSynonyms+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TupleSections+    TypeApplications+    TypeOperators+    ViewPatterns+  hs-source-dirs:   src+  build-depends:+    , aeson+    , base                  >=4.12 && <5+    , ghc+    , bytestring+    , ghc-boot+    , regex-tdfa+    , text-rope+    , ghcide                ^>=1.8+    , hls-plugin-api        ^>=1.3 || ^>=1.4 || ^>= 1.5+    , lsp+    , text+    , transformers+    , unordered-containers+    , containers+    , ghc-exactprint < 1 || >= 1.4+    , extra+    , retrie+    , syb+    , hls-graph+    , dlist+    , deepseq+    , mtl+    , lens+    , data-default+    , time+  ghc-options: -Wall -Wno-name-shadowing+  default-language: Haskell2010++test-suite tests+  if impl(ghc >= 9.3)+    buildable: False+  else+    buildable: True+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  hs-source-dirs:   test+  main-is:          Main.hs+  ghc-options:      -O0 -threaded -rtsopts -with-rtsopts=-N -Wunused-imports+  build-depends:+    , base+    , filepath+    , hls-refactor-plugin+    , hls-test-utils      ^>=1.4+    , lens+    , lsp-types+    , text+    , aeson+    , hls-plugin-api+    , parser-combinators+    , data-default+    , extra+    , text-rope+    , containers+    , ghcide+    , ghcide-test-utils+    , shake+    , hls-plugin-api+    , lsp-test+    , network-uri+    , directory+    , async+    , regex-tdfa+    , tasty-rerun+    , tasty-hunit+    , tasty-expected-failure+    , tasty
+ src/Development/IDE/GHC/Compat/ExactPrint.hs view
@@ -0,0 +1,38 @@+-- | This module contains compatibility constructs to write type signatures across+--   multiple ghc-exactprint versions, accepting that anything more ambitious is+--   pretty much impossible with the GHC 9.2 redesign of ghc-exactprint+module Development.IDE.GHC.Compat.ExactPrint+#if MIN_VERSION_ghc(9,3,0)+    ( ) where+#else+    ( ExactPrint+    , exactPrint+    , makeDeltaAst+    , Retrie.Annotated, pattern Annotated, astA, annsA+    ) where++#if !MIN_VERSION_ghc(9,2,0)+import           Control.Arrow                     ((&&&))+#else+import           Development.IDE.GHC.Compat.Parser+#endif+import           Language.Haskell.GHC.ExactPrint   as Retrie+import qualified Retrie.ExactPrint                 as Retrie++#if !MIN_VERSION_ghc(9,2,0)+class ExactPrint ast where+    makeDeltaAst :: ast -> ast+    makeDeltaAst = id++instance ExactPrint ast+#endif++#if !MIN_VERSION_ghc(9,2,0)+pattern Annotated :: ast -> Anns -> Retrie.Annotated ast+pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA))+#else+pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast+pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA))+#endif++#endif
+ src/Development/IDE/GHC/Dump.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE CPP #-}+module Development.IDE.GHC.Dump(showAstDataHtml) where+import           Data.Data                       hiding (Fixity)+import           Development.IDE.GHC.Compat      hiding (NameAnn)+import           Development.IDE.GHC.Compat.ExactPrint+#if MIN_VERSION_ghc(8,10,1)+import           GHC.Hs.Dump+#else+import           HsDumpAst+#endif+#if MIN_VERSION_ghc(9,2,1)+import qualified Data.ByteString                 as B+import           Development.IDE.GHC.Compat.Util+import           Generics.SYB                    (ext1Q, ext2Q, extQ)+import           GHC.Hs+#endif+#if MIN_VERSION_ghc(9,0,1)+import           GHC.Plugins+#else+import           GhcPlugins+#endif+import           Prelude                         hiding ((<>))++-- | Show a GHC syntax tree in HTML.+#if MIN_VERSION_ghc(9,2,1)+showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc+#else+showAstDataHtml :: (Data a, Outputable a) => a -> SDoc+#endif+showAstDataHtml a0 = html $+    header $$+    body (tag' [("id",text (show @String "myUL"))] "ul" $ vcat+        [+#if MIN_VERSION_ghc(9,2,1)+            li (pre $ text (exactPrint a0)),+            li (showAstDataHtml' a0),+            li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0)+#else+            li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan+#if MIN_VERSION_ghc(9,3,0)+                                                 NoBlankEpAnnotations+#endif+                                                 a0)+#endif+        ])+  where+    tag = tag' []+    tag' attrs t cont =+        angleBrackets (text t <+> hcat [text a<>char '=' <>v | (a,v) <- attrs])+        <> cont+        <> angleBrackets (char '/' <> text t)+    ul = tag' [("class", text (show @String "nested"))] "ul"+    li = tag "li"+    caret x = tag' [("class", text "caret")] "span" "" <+> x+    nested foo cts+#if MIN_VERSION_ghc(9,2,1) && !MIN_VERSION_ghc(9,3,0)+      | cts == empty = foo+#endif+      | otherwise = foo $$ (caret $ ul cts)+    body cts = tag "body" $ cts $$ tag "script" (text js)+    header = tag "head" $ tag "style" $ text css+    html = tag "html"+    pre = tag "pre"+#if MIN_VERSION_ghc(9,2,1)+    showAstDataHtml' :: Data a => a -> SDoc+    showAstDataHtml' =+      (generic+              `ext1Q` list+              `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan+              `extQ` annotation+              `extQ` annotationModule+              `extQ` annotationAddEpAnn+              `extQ` annotationGrhsAnn+              `extQ` annotationEpAnnHsCase+              `extQ` annotationEpAnnHsLet+              `extQ` annotationAnnList+              `extQ` annotationEpAnnImportDecl+              `extQ` annotationAnnParen+              `extQ` annotationTrailingAnn+              `extQ` annotationEpaLocation+              `extQ` addEpAnn+              `extQ` lit `extQ` litr `extQ` litt+              `extQ` sourceText+              `extQ` deltaPos+              `extQ` epaAnchor+              `extQ` anchorOp+              `extQ` bytestring+              `extQ` name `extQ` occName `extQ` moduleName `extQ` var+              `extQ` dataCon+              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet+              `extQ` fixity+              `ext2Q` located+              `extQ` srcSpanAnnA+              `extQ` srcSpanAnnL+              `extQ` srcSpanAnnP+              `extQ` srcSpanAnnC+              `extQ` srcSpanAnnN+              )++      where generic :: Data a => a -> SDoc+            generic t = nested (text $ showConstr (toConstr t))+                     (vcat (gmapQ (li . showAstDataHtml') t))++            string :: String -> SDoc+            string = text . normalize_newlines . show++            fastString :: FastString -> SDoc+            fastString s = braces $+                            text "FastString:"+                        <+> text (normalize_newlines . show $ s)++            bytestring :: B.ByteString -> SDoc+            bytestring = text . normalize_newlines . show++            list []  = brackets empty+            list [x] = "[]" $$ showAstDataHtml' x+            list xs  = nested "[]" (vcat $ map (li . showAstDataHtml') xs)++            -- Eliminate word-size dependence+            lit :: HsLit GhcPs -> SDoc+            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            lit l                  = generic l++            litr :: HsLit GhcRn -> SDoc+            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litr l                  = generic l++            litt :: HsLit GhcTc -> SDoc+            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litt l                  = generic l++            numericLit :: String -> Integer -> SourceText -> SDoc+            numericLit tag x s = braces $ hsep [ text tag+                                               , generic x+                                               , generic s ]++            sourceText :: SourceText -> SDoc+            sourceText NoSourceText     = text "NoSourceText"+            sourceText (SourceText src) = text "SourceText" <+> text src++            epaAnchor :: EpaLocation -> SDoc+            epaAnchor (EpaSpan r)  = text "EpaSpan" <+> realSrcSpan r+            epaAnchor (EpaDelta d cs) = text "EpaDelta" <+> deltaPos d <+> showAstDataHtml' cs++            anchorOp :: AnchorOperation -> SDoc+            anchorOp UnchangedAnchor  = "UnchangedAnchor"+            anchorOp (MovedAnchor dp) = "MovedAnchor " <> deltaPos dp++            deltaPos :: DeltaPos -> SDoc+            deltaPos (SameLine c) = text "SameLine" <+> ppr c+            deltaPos (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c++            name :: Name -> SDoc+            name nm    = braces $ text "Name:" <+> ppr nm++            occName n  =  braces $+                          text "OccName:"+                      <+> text (occNameString n)++            moduleName :: ModuleName -> SDoc+            moduleName m = braces $ text "ModuleName:" <+> ppr m++            srcSpan :: SrcSpan -> SDoc+            srcSpan ss = char ' ' <>+                             (hang (ppr ss) 1+                                   -- TODO: show annotations here+                                   (text ""))++            realSrcSpan :: RealSrcSpan -> SDoc+            realSrcSpan ss = braces $ char ' ' <>+                             (hang (ppr ss) 1+                                   -- TODO: show annotations here+                                   (text ""))++            addEpAnn :: AddEpAnn -> SDoc+            addEpAnn (AddEpAnn a s) = text "AddEpAnn" <+> ppr a <+> epaAnchor s++            var  :: Var -> SDoc+            var v      = braces $ text "Var:" <+> ppr v++            dataCon :: DataCon -> SDoc+            dataCon c  = braces $ text "DataCon:" <+> ppr c++            bagRdrName:: Bag (LocatedA (HsBind GhcPs)) -> SDoc+            bagRdrName bg =  braces $+                             text "Bag(LocatedA (HsBind GhcPs)):"+                          $$ (list . bagToList $ bg)++            bagName   :: Bag (LocatedA (HsBind GhcRn)) -> SDoc+            bagName bg  =  braces $+                           text "Bag(LocatedA (HsBind Name)):"+                        $$ (list . bagToList $ bg)++            bagVar    :: Bag (LocatedA (HsBind GhcTc)) -> SDoc+            bagVar bg  =  braces $+                          text "Bag(LocatedA (HsBind Var)):"+                       $$ (list . bagToList $ bg)++            nameSet ns =  braces $+                          text "NameSet:"+                       $$ (list . nameSetElemsStable $ ns)++            fixity :: Fixity -> SDoc+            fixity fx =  braces $+                         text "Fixity:"+                     <+> ppr fx++            located :: (Data a, Data b) => GenLocated a b -> SDoc+            located (L ss a)+              = nested "L" $ (li (showAstDataHtml' ss) $$ li (showAstDataHtml' a))++            -- -------------------------++            annotation :: EpAnn [AddEpAnn] -> SDoc+            annotation = annotation' (text "EpAnn [AddEpAnn]")++            annotationModule :: EpAnn AnnsModule -> SDoc+            annotationModule = annotation' (text "EpAnn AnnsModule")++            annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc+            annotationAddEpAnn = annotation' (text "EpAnn AddEpAnn")++            annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc+            annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn")++            annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc+            annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase")++            annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc+            annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet")++            annotationAnnList :: EpAnn AnnList -> SDoc+            annotationAnnList = annotation' (text "EpAnn AnnList")++            annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc+            annotationEpAnnImportDecl = annotation' (text "EpAnn EpAnnImportDecl")++            annotationAnnParen :: EpAnn AnnParen -> SDoc+            annotationAnnParen = annotation' (text "EpAnn AnnParen")++            annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc+            annotationTrailingAnn = annotation' (text "EpAnn TrailingAnn")++            annotationEpaLocation :: EpAnn EpaLocation -> SDoc+            annotationEpaLocation = annotation' (text "EpAnn EpaLocation")++            annotation' :: forall a .(Data a, Typeable a)+                       => SDoc -> EpAnn a -> SDoc+            annotation' tag anns = nested (text $ showConstr (toConstr anns))+              (vcat (map li $ gmapQ showAstDataHtml' anns))++            -- -------------------------++            srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc+            srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA")++            srcSpanAnnL :: SrcSpanAnn' (EpAnn AnnList) -> SDoc+            srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL")++            srcSpanAnnP :: SrcSpanAnn' (EpAnn AnnPragma) -> SDoc+            srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP")++            srcSpanAnnC :: SrcSpanAnn' (EpAnn AnnContext) -> SDoc+            srcSpanAnnC = locatedAnn'' (text "SrcSpanAnnC")++            srcSpanAnnN :: SrcSpanAnn' (EpAnn NameAnn) -> SDoc+            srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN")++            locatedAnn'' :: forall a. (Typeable a, Data a)+              => SDoc -> SrcSpanAnn' a -> SDoc+            locatedAnn'' tag ss =+              case cast ss of+                Just ((SrcSpanAnn ann s) :: SrcSpanAnn' a) ->+                      nested "SrcSpanAnn" $ (+                                 li(showAstDataHtml' ann)+                              $$ li(srcSpan s))+                Nothing -> text "locatedAnn:unmatched" <+> tag+                           <+> (text (showConstr (toConstr ss)))+#endif+++normalize_newlines :: String -> String+normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs+normalize_newlines (x:xs)                 = x:normalize_newlines xs+normalize_newlines []                     = []++css :: String+css = unlines+  [ "body {background-color: black; color: white ;}"+  , "/* Remove default bullets */"+  , "ul, #myUL {"+  , "  list-style-type: none;"+  , "}"+  , "/* Remove margins and padding from the parent ul */"+  , "#myUL {"+  , "  margin: 0;                       "+  , "  padding: 0;                      "+  , "}                                  "+  , "/* Style the caret/arrow */        "+  , ".caret {                           "+  , "  cursor: pointer;                 "+  , "  user-select: none; /* Prevent text selection */"+  , "}                                  "+  , "/* Create the caret/arrow with a unicode, and style it */"+  , ".caret::before {                   "+  , "  content: \"\\25B6 \";                "+  , "  color: white;                    "+  , "  display: inline-block;           "+  , "  margin-right: 6px;               "+  , "}                                  "+  , "/* Rotate the caret/arrow icon when clicked on (using JavaScript) */"+  , ".caret-down::before {              "+  , "  transform: rotate(90deg);        "+  , "}                                  "+  , "/* Hide the nested list */         "+  , ".nested {                          "+  , "  display: none;                   "+  , "}                                  "+  , "/* Show the nested list when the user clicks on the caret/arrow (with JavaScript) */"+  , ".active {                          "+  , "  display: block;}"+  ]++js :: String+js = unlines+  [ "var toggler = document.getElementsByClassName(\"caret\");"+  , "var i;"+  , "for (i = 0; i < toggler.length; i++) {"+  , "  toggler[i].addEventListener(\"click\", function() {"+  , "    this.parentElement.querySelector(\".nested\").classList.toggle(\"active\");"+  , "    this.classList.toggle(\"caret-down\");"+  , "  }); }"+  ]
+ src/Development/IDE/GHC/ExactPrint.hs view
@@ -0,0 +1,672 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs        #-}++-- | This module hosts various abstractions and utility functions to work with ghc-exactprint.+module Development.IDE.GHC.ExactPrint+#if MIN_VERSION_ghc(9,3,0)+   (  ) where+#else+    ( Graft(..),+      graftDecls,+      graftDeclsWithM,+      annotate,+      annotateDecl,+      hoistGraft,+      graftWithM,+      graftExprWithM,+      genericGraftWithSmallestM,+      genericGraftWithLargestM,+      graftSmallestDeclsWithM,+      transform,+      transformM,+      ExactPrint(..),+#if !MIN_VERSION_ghc(9,2,0)+      Anns,+      Annotate,+      setPrecedingLinesT,+#else+      addParens,+      addParensToCtxt,+      modifyAnns,+      removeComma,+      -- * Helper function+      eqSrcSpan,+      epl,+      epAnn,+      removeTrailingComma,+#endif+      annotateParsedSource,+      getAnnotatedParsedSourceRule,+      GetAnnotatedParsedSource(..),+      ASTElement (..),+      ExceptStringT (..),+      TransformT,+      Log(..),+    )+where++import           Control.Applicative                     (Alternative)+import           Control.Arrow                           (right, (***))+import           Control.DeepSeq+import           Control.Monad+import qualified Control.Monad.Fail                      as Fail+import           Control.Monad.IO.Class                  (MonadIO)+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Except+import           Control.Monad.Zip+import           Data.Bifunctor+import           Data.Bool                               (bool)+import qualified Data.DList                              as DL+import           Data.Either.Extra                       (mapLeft)+import           Data.Foldable                           (Foldable (fold))+import           Data.Functor.Classes+import           Data.Functor.Contravariant+import           Data.Monoid                             (All (All), getAll)+import qualified Data.Text                               as T+import           Data.Traversable                        (for)+import           Development.IDE.Core.RuleTypes+import           Development.IDE.Core.Service            (runAction)+import           Development.IDE.Core.Shake              hiding (Log)+import qualified Development.IDE.Core.Shake              as Shake+import           Development.IDE.GHC.Compat              hiding (parseImport,+                                                          parsePattern,+                                                          parseType)+import           Development.IDE.GHC.Compat.ExactPrint+import           Development.IDE.Graph                   (RuleResult, Rules)+import           Development.IDE.Graph.Classes+import           Development.IDE.Types.Location+import           Development.IDE.Types.Logger            (Pretty (pretty),+                                                          Recorder,+                                                          WithPriority,+                                                          cmapWithPrio)+import           Generics.SYB+import           Generics.SYB.GHC+import qualified GHC.Generics                            as GHC+import           Ide.PluginUtils+import           Language.Haskell.GHC.ExactPrint.Parsers+import           Language.LSP.Types+import           Language.LSP.Types.Capabilities         (ClientCapabilities)+import           Retrie.ExactPrint                       hiding (Annotated (..),+                                                          parseDecl, parseExpr,+                                                          parsePattern,+                                                          parseType)+#if MIN_VERSION_ghc(9,2,0)+import           GHC                                     (EpAnn (..),+                                                          NameAdornment (NameParens),+                                                          NameAnn (..),+                                                          SrcSpanAnn' (SrcSpanAnn),+                                                          SrcSpanAnnA,+                                                          TrailingAnn (AddCommaAnn),+                                                          emptyComments,+                                                          spanAsAnchor)+import           GHC.Parser.Annotation                   (AnnContext (..),+                                                          DeltaPos (SameLine),+                                                          EpaLocation (EpaDelta))+#endif++------------------------------------------------------------------------------++data Log = LogShake Shake.Log deriving Show++instance Pretty Log where+  pretty = \case+    LogShake shakeLog -> pretty shakeLog++instance Show (Annotated ParsedSource) where+  show _ = "<Annotated ParsedSource>"+ +instance NFData (Annotated ParsedSource) where+  rnf = rwhnf+ +data GetAnnotatedParsedSource = GetAnnotatedParsedSource+  deriving (Eq, Show, Typeable, GHC.Generic)++instance Hashable GetAnnotatedParsedSource+instance NFData GetAnnotatedParsedSource+type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource++-- | Get the latest version of the annotated parse source with comments.+getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules ()+getAnnotatedParsedSourceRule recorder = define (cmapWithPrio LogShake recorder) $ \GetAnnotatedParsedSource nfp -> do+  pm <- use GetParsedModuleWithComments nfp+  return ([], fmap annotateParsedSource pm)++#if MIN_VERSION_ghc(9,2,0)+annotateParsedSource :: ParsedModule -> Annotated ParsedSource+annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA (makeDeltaAst ps) 0+#else+annotateParsedSource :: ParsedModule -> Annotated ParsedSource+annotateParsedSource = fixAnns+#endif++------------------------------------------------------------------------------++{- | A transformation for grafting source trees together. Use the semigroup+ instance to combine 'Graft's, and run them via 'transform'.+-}+newtype Graft m a = Graft+    { runGraft :: DynFlags -> a -> TransformT m a+    }++hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a+hoistGraft h (Graft f) = Graft (fmap (hoistTransform h) . f)++newtype ExceptStringT m a = ExceptStringT {runExceptString :: ExceptT String m a}+    deriving newtype+        ( MonadTrans+        , Monad+        , Functor+        , Applicative+        , Alternative+        , Foldable+        , Contravariant+        , MonadIO+        , Eq1+        , Ord1+        , Show1+        , Read1+        , MonadZip+        , MonadPlus+        , Eq+        , Ord+        , Show+        , Read+        )++instance Monad m => Fail.MonadFail (ExceptStringT m) where+    fail = ExceptStringT . ExceptT . pure . Left++instance Monad m => Semigroup (Graft m a) where+    Graft a <> Graft b = Graft $ \dflags -> a dflags >=> b dflags++instance Monad m => Monoid (Graft m a) where+    mempty = Graft $ const pure++------------------------------------------------------------------------------++-- | Convert a 'Graft' into a 'WorkspaceEdit'.+transform ::+    DynFlags ->+    ClientCapabilities ->+    Uri ->+    Graft (Either String) ParsedSource ->+    Annotated ParsedSource ->+    Either String WorkspaceEdit+transform dflags ccs uri f a = do+    let src = printA a+    a' <- transformA a $ runGraft f dflags+    let res = printA a'+    pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions++------------------------------------------------------------------------------++-- | Convert a 'Graft' into a 'WorkspaceEdit'.+transformM ::+    Monad m =>+    DynFlags ->+    ClientCapabilities ->+    Uri ->+    Graft (ExceptStringT m) ParsedSource ->+    Annotated ParsedSource ->+    m (Either String WorkspaceEdit)+transformM dflags ccs uri f a = runExceptT $+    runExceptString $ do+        let src = printA a+        a' <- transformA a $ runGraft f dflags+        let res = printA a'+        pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions+++-- | Returns whether or not this node requires its immediate children to have+-- be parenthesized and have a leading space.+--+-- A more natural type for this function would be to return @(Bool, Bool)@, but+-- we use 'All' instead for its monoid instance.+needsParensSpace ::+    HsExpr GhcPs ->+    -- | (Needs parens, needs space)+    (All, All)+needsParensSpace HsLam{}         = (All False, All False)+needsParensSpace HsLamCase{}     = (All False, All True)+needsParensSpace HsApp{}         = mempty+needsParensSpace HsAppType{}     = mempty+needsParensSpace OpApp{}         = mempty+needsParensSpace HsPar{}         = (All False, All False)+needsParensSpace SectionL{}      = (All False, All False)+needsParensSpace SectionR{}      = (All False, All False)+needsParensSpace ExplicitTuple{} = (All False, All False)+needsParensSpace ExplicitSum{}   = (All False, All False)+needsParensSpace HsCase{}        = (All False, All True)+needsParensSpace HsIf{}          = (All False, All False)+needsParensSpace HsMultiIf{}     = (All False, All False)+needsParensSpace HsLet{}         = (All False, All True)+needsParensSpace HsDo{}          = (All False, All False)+needsParensSpace ExplicitList{}  = (All False, All False)+needsParensSpace RecordCon{}     = (All False, All True)+needsParensSpace RecordUpd{}     = mempty+needsParensSpace _               = mempty+++------------------------------------------------------------------------------++{- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with the+ given @Located ast@. The node at that position must already be a @Located+ ast@, or this is a no-op.+-}+graft' ::+    forall ast a l.+    (Data a, Typeable l, ASTElement l ast) =>+    -- | Do we need to insert a space before this grafting? In do blocks, the+    -- answer is no, or we will break layout. But in function applications,+    -- the answer is yes, or the function call won't get its argument. Yikes!+    --+    -- More often the answer is yes, so when in doubt, use that.+    Bool ->+    SrcSpan ->+    LocatedAn l ast ->+    Graft (Either String) a+graft' needs_space dst val = Graft $ \dflags a -> do+#if MIN_VERSION_ghc(9,2,0)+    val' <- annotate dflags needs_space val+#else+    (anns, val') <- annotate dflags needs_space val+    modifyAnnsT $ mappend anns+#endif+    pure $+        everywhere'+            ( mkT $+                \case+                    (L src _ :: LocatedAn l ast)+                        | locA src `eqSrcSpan` dst -> val'+                    l                         -> l+            )+            a+++-- | Like 'graft', but specialized to 'LHsExpr', and intelligently inserts+-- parentheses if they're necessary.+graftExpr ::+    forall a.+    (Data a) =>+    SrcSpan ->+    LHsExpr GhcPs ->+    Graft (Either String) a+graftExpr dst val = Graft $ \dflags a -> do+    let (needs_space, mk_parens) = getNeedsSpaceAndParenthesize dst a++    runGraft+      (graft' needs_space dst $ mk_parens val)+      dflags+      a++getNeedsSpaceAndParenthesize ::+    (ASTElement l ast, Data a) =>+    SrcSpan ->+    a ->+    (Bool, LocatedAn l ast -> LocatedAn l ast)+getNeedsSpaceAndParenthesize dst a =+  -- Traverse the tree, looking for our replacement node. But keep track of+  -- the context (parent HsExpr constructor) we're in while we do it. This+  -- lets us determine wehther or not we need parentheses.+  let (needs_parens, needs_space) =+          everythingWithContext (Nothing, Nothing) (<>)+            ( mkQ (mempty, ) $ \x s -> case x of+                (L src _ :: LHsExpr GhcPs) | locA src `eqSrcSpan` dst ->+                  (s, s)+                L _ x' -> (mempty, Just *** Just $ needsParensSpace x')+            ) a+   in ( maybe True getAll needs_space+      , bool id maybeParensAST $ maybe False getAll needs_parens+      )+++------------------------------------------------------------------------------++graftExprWithM ::+    forall m a.+    (Fail.MonadFail m, Data a) =>+    SrcSpan ->+    (LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))) ->+    Graft m a+graftExprWithM dst trans = Graft $ \dflags a -> do+    let (needs_space, mk_parens) = getNeedsSpaceAndParenthesize dst a++    everywhereM'+        ( mkM $+            \case+                val@(L src _ :: LHsExpr GhcPs)+                    | locA src `eqSrcSpan` dst -> do+                        mval <- trans val+                        case mval of+                            Just val' -> do+#if MIN_VERSION_ghc(9,2,0)+                                val'' <-+                                    hoistTransform (either Fail.fail pure)+                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))+                                pure val''+#else+                                (anns, val'') <-+                                    hoistTransform (either Fail.fail pure)+                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))+                                modifyAnnsT $ mappend anns+                                pure val''+#endif+                            Nothing -> pure val+                l -> pure l+        )+        a++graftWithM ::+    forall ast m a l.+    (Fail.MonadFail m, Data a, Typeable l, ASTElement l ast) =>+    SrcSpan ->+    (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))) ->+    Graft m a+graftWithM dst trans = Graft $ \dflags a -> do+    everywhereM'+        ( mkM $+            \case+                val@(L src _ :: LocatedAn l ast)+                    | locA src `eqSrcSpan` dst -> do+                        mval <- trans val+                        case mval of+                            Just val' -> do+#if MIN_VERSION_ghc(9,2,0)+                                val'' <-+                                    hoistTransform (either Fail.fail pure) $+                                        annotate dflags True $ maybeParensAST val'+                                pure val''+#else+                                (anns, val'') <-+                                    hoistTransform (either Fail.fail pure) $+                                        annotate dflags True $ maybeParensAST val'+                                modifyAnnsT $ mappend anns+                                pure val''+#endif+                            Nothing -> pure val+                l -> pure l+        )+        a++-- | Run the given transformation only on the smallest node in the tree that+-- contains the 'SrcSpan'.+genericGraftWithSmallestM ::+    forall m a ast.+    (Monad m, Data a, Typeable ast) =>+    -- | The type of nodes we'd like to consider when finding the smallest.+    Proxy (Located ast) ->+    SrcSpan ->+    (DynFlags -> ast -> GenericM (TransformT m)) ->+    Graft m a+genericGraftWithSmallestM proxy dst trans = Graft $ \dflags ->+    smallestM (genericIsSubspan proxy dst) (trans dflags)++-- | Run the given transformation only on the largest node in the tree that+-- contains the 'SrcSpan'.+genericGraftWithLargestM ::+    forall m a ast.+    (Monad m, Data a, Typeable ast) =>+    -- | The type of nodes we'd like to consider when finding the largest.+    Proxy (Located ast) ->+    SrcSpan ->+    (DynFlags -> ast -> GenericM (TransformT m)) ->+    Graft m a+genericGraftWithLargestM proxy dst trans = Graft $ \dflags ->+    largestM (genericIsSubspan proxy dst) (trans dflags)+++graftDecls ::+    forall a.+    (HasDecls a) =>+    SrcSpan ->+    [LHsDecl GhcPs] ->+    Graft (Either String) a+graftDecls dst decs0 = Graft $ \dflags a -> do+    decs <- forM decs0 $ \decl -> do+        annotateDecl dflags decl+    let go [] = DL.empty+        go (L src e : rest)+            | locA src `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest+            | otherwise = DL.singleton (L src e) <> go rest+    modifyDeclsT (pure . DL.toList . go) a++graftSmallestDeclsWithM ::+    forall a.+    (HasDecls a) =>+    SrcSpan ->+    (LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])) ->+    Graft (Either String) a+graftSmallestDeclsWithM dst toDecls = Graft $ \dflags a -> do+    let go [] = pure DL.empty+        go (e@(L src _) : rest)+            | dst `isSubspanOf` locA src = toDecls e >>= \case+                Just decs0 -> do+                    decs <- forM decs0 $ \decl ->+                        annotateDecl dflags decl+                    pure $ DL.fromList decs <> DL.fromList rest+                Nothing -> (DL.singleton e <>) <$> go rest+            | otherwise = (DL.singleton e <>) <$> go rest+    modifyDeclsT (fmap DL.toList . go) a++graftDeclsWithM ::+    forall a m.+    (HasDecls a, Fail.MonadFail m) =>+    SrcSpan ->+    (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])) ->+    Graft m a+graftDeclsWithM dst toDecls = Graft $ \dflags a -> do+    let go [] = pure DL.empty+        go (e@(L src _) : rest)+            | locA src `eqSrcSpan` dst = toDecls e >>= \case+                Just decs0 -> do+                    decs <- forM decs0 $ \decl ->+                        hoistTransform (either Fail.fail pure) $+                          annotateDecl dflags decl+                    pure $ DL.fromList decs <> DL.fromList rest+                Nothing -> (DL.singleton e <>) <$> go rest+            | otherwise = (DL.singleton e <>) <$> go rest+    modifyDeclsT (fmap DL.toList . go) a+++class (Data ast, Typeable l, Outputable l, Outputable ast) => ASTElement l ast | ast -> l where+    parseAST :: Parser (LocatedAn l ast)+    maybeParensAST :: LocatedAn l ast -> LocatedAn l ast+    {- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with+        the given @Located ast@. The node at that position must already be+        a @Located ast@, or this is a no-op.+    -}+    graft ::+        forall a.+        (Data a) =>+        SrcSpan ->+        LocatedAn l ast ->+        Graft (Either String) a+    graft dst = graft' True dst . maybeParensAST++instance p ~ GhcPs => ASTElement AnnListItem (HsExpr p) where+    parseAST = parseExpr+    maybeParensAST = parenthesize+    graft = graftExpr++instance p ~ GhcPs => ASTElement AnnListItem (Pat p) where+#if __GLASGOW_HASKELL__ == 808+    parseAST = fmap (fmap $ right $ second dL) . parsePattern+    maybeParensAST = dL . parenthesizePat appPrec . unLoc+#else+    parseAST = parsePattern+    maybeParensAST = parenthesizePat appPrec+#endif++instance p ~ GhcPs => ASTElement AnnListItem (HsType p) where+    parseAST = parseType+    maybeParensAST = parenthesizeHsType appPrec++instance p ~ GhcPs => ASTElement AnnListItem (HsDecl p) where+    parseAST = parseDecl+    maybeParensAST = id++instance p ~ GhcPs => ASTElement AnnListItem (ImportDecl p) where+    parseAST = parseImport+    maybeParensAST = id++instance ASTElement NameAnn RdrName where+    parseAST df fp = parseWith df fp parseIdentifier+    maybeParensAST = id++------------------------------------------------------------------------------++#if !MIN_VERSION_ghc(9,2,0)+-- | Dark magic I stole from retrie. No idea what it does.+fixAnns :: ParsedModule -> Annotated ParsedSource+fixAnns ParsedModule {..} =+    let ranns = relativiseApiAnns pm_parsed_source pm_annotations+     in unsafeMkA pm_parsed_source ranns 0+#endif++------------------------------------------------------------------------------++-- | Given an 'LHSExpr', compute its exactprint annotations.+--   Note that this function will throw away any existing annotations (and format)+annotate :: (ASTElement l ast, Outputable l)+#if MIN_VERSION_ghc(9,2,0)+    => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)+#else+    => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (Anns, LocatedAn l ast)+#endif+annotate dflags needs_space ast = do+    uniq <- show <$> uniqueSrcSpanT+    let rendered = render dflags ast+#if MIN_VERSION_ghc(9,2,0)+    expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered+    pure expr'+#else+    (anns, expr') <- lift $ mapLeft show $ parseAST dflags uniq rendered+    let anns' = setPrecedingLines expr' 0 (bool 0 1 needs_space) anns+    pure (anns',expr')+#endif++-- | Given an 'LHsDecl', compute its exactprint annotations.+annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)+-- The 'parseDecl' function fails to parse 'FunBind' 'ValD's which contain+-- multiple matches. To work around this, we split the single+-- 'FunBind'-of-multiple-'Match'es into multiple 'FunBind's-of-one-'Match',+-- and then merge them all back together.+annotateDecl dflags+            (L src (+                ValD ext fb@FunBind+                  { fun_matches = mg@MG { mg_alts = L alt_src alts@(_:_)}+                  })) = do+    let set_matches matches =+          ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }}++#if MIN_VERSION_ghc(9,2,0)+    alts' <- for alts $ \alt -> do+      uniq <- show <$> uniqueSrcSpanT+      let rendered = render dflags $ set_matches [alt]+      lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case+        (L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))+           -> pure alt'+        _ ->  lift $ Left "annotateDecl: didn't parse a single FunBind match"++    pure $ L src $ set_matches alts'+#else+    (anns', alts') <- fmap unzip $ for alts $ \alt -> do+      uniq <- show <$> uniqueSrcSpanT+      let rendered = render dflags $ set_matches [alt]+      lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case+        (ann, L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))+           -> pure (setPrecedingLines alt' 1 0 ann, alt')+        _ ->  lift $ Left "annotateDecl: didn't parse a single FunBind match"++    modifyAnnsT $ mappend $ fold anns'+    pure $ L src $ set_matches alts'+#endif+annotateDecl dflags ast = do+    uniq <- show <$> uniqueSrcSpanT+    let rendered = render dflags ast+#if MIN_VERSION_ghc(9,2,0)+    lift $ mapLeft show $ parseDecl dflags uniq rendered+#else+    (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered+    let anns' = setPrecedingLines expr' 1 0 anns+    modifyAnnsT $ mappend anns'+    pure expr'+#endif++------------------------------------------------------------------------------++-- | Print out something 'Outputable'.+render :: Outputable a => DynFlags -> a -> String+render dflags = showSDoc dflags . ppr++------------------------------------------------------------------------------++-- | Put parentheses around an expression if required.+parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs+parenthesize = parenthesizeHsExpr appPrec++------------------------------------------------------------------------------++-- | Equality on SrcSpan's.+-- Ignores the (Maybe BufSpan) field of SrcSpan's.+eqSrcSpan :: SrcSpan -> SrcSpan -> Bool+eqSrcSpan l r = leftmost_smallest l r == EQ++-- | Equality on SrcSpan's.+-- Ignores the (Maybe BufSpan) field of SrcSpan's.+#if MIN_VERSION_ghc(9,2,0)+eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool+eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ+#else+eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool+eqSrcSpanA l r = leftmost_smallest l r == EQ+#endif++#if MIN_VERSION_ghc(9,2,0)+addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext+addParensToCtxt close_dp = addOpen . addClose+  where+      addOpen it@AnnContext{ac_open = []} = it{ac_open = [epl 0]}+      addOpen other                       = other+      addClose it+        | Just c <- close_dp = it{ac_close = [c]}+        | AnnContext{ac_close = []} <- it = it{ac_close = [epl 0]}+        | otherwise = it++epl :: Int -> EpaLocation+epl n = EpaDelta (SameLine n) []++epAnn :: SrcSpan -> ann -> EpAnn ann+epAnn srcSpan anns = EpAnn (spanAsAnchor srcSpan) anns emptyComments++modifyAnns :: LocatedAn a ast -> (a -> a) -> LocatedAn a ast+modifyAnns x f = first ((fmap.fmap) f) x++removeComma :: SrcSpanAnnA -> SrcSpanAnnA+removeComma it@(SrcSpanAnn EpAnnNotUsed _) = it+removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l)+  = (SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l)+  where+      isCommaAnn AddCommaAnn{} = True+      isCommaAnn _             = False++addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn+addParens True it@NameAnn{} =+        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }+addParens True it@NameAnnCommas{} =+        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }+addParens True it@NameAnnOnly{} =+        it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 }+addParens True NameAnnTrailing{..} =+        NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..}+addParens _ it = it++removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast+removeTrailingComma = flip modifyAnns $ \(AnnListItem l) -> AnnListItem $ filter (not . isCommaAnn) l++isCommaAnn :: TrailingAnn -> Bool+isCommaAnn AddCommaAnn{} = True+isCommaAnn _             = False+#endif++#endif
+ src/Development/IDE/Plugin/CodeAction.hs view
@@ -0,0 +1,2062 @@+-- Copyright (c) 2019 The DAML Authors. All rights reserved.+-- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE GADTs #-}++module Development.IDE.Plugin.CodeAction+    (+    mkExactprintPluginDescriptor,+    iePluginDescriptor,+    typeSigsPluginDescriptor,+    bindingsPluginDescriptor,+    fillHolePluginDescriptor,+    extendImportPluginDescriptor,+    -- * For testing+    matchRegExMultipleImports+    ) where++import           Control.Applicative                               ((<|>))+import           Control.Arrow                                     (second,+                                                                    (&&&),+                                                                    (>>>))+import           Control.Concurrent.STM.Stats                      (atomically)+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Maybe+import           Control.Monad.Extra+import           Data.Aeson+import           Data.Char+import qualified Data.DList                                        as DL+import           Data.Function+import           Data.Functor+import qualified Data.HashMap.Strict                               as Map+import qualified Data.HashSet                                      as Set+import           Data.List.Extra+import           Data.List.NonEmpty                                (NonEmpty ((:|)))+import qualified Data.List.NonEmpty                                as NE+import qualified Data.Map.Strict                                   as M+import           Data.Maybe+import           Data.Ord                                          (comparing)+import qualified Data.Set                                          as S+import qualified Data.Text                                         as T+import qualified Data.Text.Utf16.Rope                              as Rope+import           Data.Tuple.Extra                                  (fst3)+import           Development.IDE.Types.Logger                      hiding (group)+import           Development.IDE.Core.Rules+import           Development.IDE.Core.RuleTypes+import           Development.IDE.Core.Service+import           Development.IDE.GHC.Compat+import           Development.IDE.GHC.Compat.ExactPrint+import           Development.IDE.GHC.Compat.Util+import           Development.IDE.GHC.Error+import           Development.IDE.GHC.ExactPrint+import qualified Development.IDE.GHC.ExactPrint                   as E+import           Development.IDE.GHC.Util                          (printOutputable,+                                                                    printRdrName)+import           Development.IDE.Core.Shake                   hiding (Log)+import           Development.IDE.Plugin.CodeAction.Args+import           Development.IDE.Plugin.CodeAction.ExactPrint+import           Development.IDE.Plugin.CodeAction.Util+import           Development.IDE.Plugin.CodeAction.PositionIndexed+import           Development.IDE.Plugin.Completions.Types+import           Development.IDE.Plugin.TypeLenses                 (suggestSignature)+import           Development.IDE.Types.Exports+import           Development.IDE.Types.Location+import           Development.IDE.Types.Options+import qualified GHC.LanguageExtensions                            as Lang+import           Ide.PluginUtils                                   (subRange)+import           Ide.Types+import qualified Language.LSP.Server                               as LSP+import           Language.LSP.Types                                (ApplyWorkspaceEditParams(..), CodeAction (..),+                                                                    CodeActionContext (CodeActionContext, _diagnostics),+                                                                    CodeActionKind (CodeActionQuickFix, CodeActionUnknown),+                                                                    CodeActionParams (CodeActionParams),+                                                                    Command,+                                                                    Diagnostic (..),+                                                                    MessageType (..),+                                                                    ShowMessageParams (..),+                                                                    List (..),+                                                                    ResponseError,+                                                                    SMethod (..),+                                                                    TextDocumentIdentifier (TextDocumentIdentifier),+                                                                    TextEdit (TextEdit, _range),+                                                                    UInt,+                                                                    WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges),+                                                                    type (|?) (InR),+                                                                    uriToFilePath)+import           GHC.Exts                                           (fromList)+import           Language.LSP.VFS                                  (VirtualFile,+                                                                    _file_text)+import           Text.Regex.TDFA                                   (mrAfter,+                                                                    (=~), (=~~))+#if MIN_VERSION_ghc(9,2,0)+import           GHC                                               (AddEpAnn (AddEpAnn),+                                                                    Anchor (anchor_op),+                                                                    AnchorOperation (..),+                                                                    AnnsModule (am_main),+                                                                    DeltaPos (..),+                                                                    EpAnn (..),+                                                                    EpaLocation (..),+                                                                    LEpaComment,+                                                                    LocatedA)++#else+import           Language.Haskell.GHC.ExactPrint.Types             (Annotation (annsDP),+                                                                    DeltaPos,+                                                                    KeywordId (G),+                                                                    deltaRow,+                                                                    mkAnnKey)+#endif++-------------------------------------------------------------------------------------------------++-- | Generate code actions.+codeAction+    :: IdeState+    -> PluginId+    -> CodeActionParams+    -> LSP.LspM c (Either ResponseError (List (Command |? CodeAction)))+codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List xs}) = do+  contents <- LSP.getVirtualFile $ toNormalizedUri uri+  liftIO $ do+    let text = Rope.toText . (_file_text :: VirtualFile -> Rope.Rope) <$> contents+        mbFile = toNormalizedFilePath' <$> uriToFilePath uri+    diag <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state+    (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile+    let+      actions = caRemoveRedundantImports parsedModule text diag xs uri+               <> caRemoveInvalidExports parsedModule text diag xs uri+    pure $ Right $ List actions++-------------------------------------------------------------------------------------------------++iePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState+iePluginDescriptor recorder plId =+  let old =+        mkGhcideCAsPlugin [+            wrap suggestExportUnusedTopBinding+          , wrap suggestModuleTypo+          , wrap suggestFixConstructorImport+          , wrap suggestNewImport+#if !MIN_VERSION_ghc(9,3,0)+          , wrap suggestExtendImport+          , wrap suggestImportDisambiguation+          , wrap suggestNewOrExtendImportForClassMethod+          , wrap suggestHideShadow+#endif+          ]+          plId+   in mkExactprintPluginDescriptor recorder $ old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction }++typeSigsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState+typeSigsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $+  mkGhcideCAsPlugin [+      wrap $ suggestSignature True+    , wrap suggestFillTypeWildcard+    , wrap suggestAddTypeAnnotationToSatisfyContraints+#if !MIN_VERSION_ghc(9,3,0)+    , wrap removeRedundantConstraints+    , wrap suggestConstraint+#endif+    ]+    plId++bindingsPluginDescriptor :: Recorder (WithPriority E.Log) ->  PluginId -> PluginDescriptor IdeState+bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $+  mkGhcideCAsPlugin [+      wrap suggestReplaceIdentifier+#if !MIN_VERSION_ghc(9,3,0)+    , wrap suggestImplicitParameter+#endif+    , wrap suggestNewDefinition+    , wrap suggestDeleteUnusedBinding+    ]+    plId++fillHolePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState+fillHolePluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder (mkGhcideCAPlugin (wrap suggestFillHole) plId)++extendImportPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState+extendImportPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor plId)+  { pluginCommands = [extendImportCommand] }+++-- | Add the ability for a plugin to call GetAnnotatedParsedSource+mkExactprintPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginDescriptor a -> PluginDescriptor a+mkExactprintPluginDescriptor recorder desc = desc { pluginRules = pluginRules desc >> getAnnotatedParsedSourceRule recorder }++-------------------------------------------------------------------------------------------------+++extendImportCommand :: PluginCommand IdeState+extendImportCommand =+  PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler++extendImportHandler :: CommandFunction IdeState ExtendImport+extendImportHandler ideState edit@ExtendImport {..} = do+  res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit+  whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do+    let (_, List (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . Map.toList+        srcSpan = rangeToSrcSpan nfp _range+    LSP.sendNotification SWindowShowMessage $+      ShowMessageParams MtInfo $+        "Import "+          <> maybe ("‘" <> newThing) (\x -> "‘" <> x <> " (" <> newThing <> ")") thingParent+          <> "’ from "+          <> importName+          <> " (at "+          <> printOutputable srcSpan+          <> ")"+    void $ LSP.sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())+  return $ Right Null++extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)+extendImportHandler' ideState ExtendImport {..}+  | Just fp <- uriToFilePath doc,+    nfp <- toNormalizedFilePath' fp =+    do+      (ModSummaryResult {..}, ps, contents) <- MaybeT $ liftIO $+        runAction "extend import" ideState $+          runMaybeT $ do+            -- We want accurate edits, so do not use stale data here+            msr <- MaybeT $ use GetModSummaryWithoutTimestamps nfp+            ps <- MaybeT $ use GetAnnotatedParsedSource nfp+            (_, contents) <- MaybeT $ use GetFileContents nfp+            return (msr, ps, contents)+      let df = ms_hspp_opts msrModSummary+          wantedModule = mkModuleName (T.unpack importName)+          wantedQual = mkModuleName . T.unpack <$> importQual+          existingImport = find (isWantedModule wantedModule wantedQual) msrImports+      case existingImport of+        Just imp -> do+            fmap (nfp,) $ liftEither $+              rewriteToWEdit df doc+#if !MIN_VERSION_ghc(9,2,0)+                (annsA ps)+#endif+                $+                  extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp)++        Nothing -> do+            let n = newImport importName sym importQual False+                sym = if isNothing importQual then Just it else Nothing+                it = case thingParent of+                  Nothing -> newThing+                  Just p  -> p <> "(" <> newThing <> ")"+            t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents)+            return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing})+  | otherwise =+    mzero++isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool+isWantedModule wantedModule Nothing (L _ it@ImportDecl{ideclName, ideclHiding = Just (False, _)}) =+    not (isQualifiedImport it) && unLoc ideclName == wantedModule+isWantedModule wantedModule (Just qual) (L _ ImportDecl{ideclAs, ideclName, ideclHiding = Just (False, _)}) =+    unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc . reLoc <$> ideclAs) == Just qual)+isWantedModule _ _ _ = False+++liftMaybe :: Monad m => Maybe a -> MaybeT m a+liftMaybe a = MaybeT $ pure a++liftEither :: Monad m => Either e a -> MaybeT m a+liftEither (Left _)  = mzero+liftEither (Right x) = return x++-------------------------------------------------------------------------------------------------++findSigOfDecl :: p ~ GhcPass p0 => (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)+findSigOfDecl pred decls =+  listToMaybe+    [ sig+      | L _ (SigD _ sig@(TypeSig _ idsSig _)) <- decls,+        any (pred . unLoc) idsSig+    ]++findSigOfDeclRanged :: forall p p0 . p ~ GhcPass p0 => Range -> [LHsDecl p] -> Maybe (Sig p)+findSigOfDeclRanged range decls = do+  dec <- findDeclContainingLoc (_start range) decls+  case dec of+     L _ (SigD _ sig@TypeSig {})     -> Just sig+     L _ (ValD _ (bind :: HsBind p)) -> findSigOfBind range bind+     _                               -> Nothing++findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p)+findSigOfBind range bind =+    case bind of+      FunBind {} -> findSigOfLMatch (unLoc $ mg_alts (fun_matches bind))+      _          -> Nothing+  where+    findSigOfLMatch :: [LMatch p (LHsExpr p)] -> Maybe (Sig p)+    findSigOfLMatch ls = do+      match <- findDeclContainingLoc (_start range) ls+      let grhs = m_grhss $ unLoc match+#if !MIN_VERSION_ghc(9,2,0)+          span = getLoc $ reLoc $ grhssLocalBinds grhs+      if _start range `isInsideSrcSpan` span+        then findSigOfBinds range (unLoc (grhssLocalBinds grhs)) -- where clause+        else do+          grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)+          case unLoc grhs of+            GRHS _ _ bd -> findSigOfExpr (unLoc bd)+            _           -> Nothing+#else+      msum+        [findSigOfBinds range (grhssLocalBinds grhs) -- where clause+        , do+#if MIN_VERSION_ghc(9,3,0)+          grhs <- findDeclContainingLoc (_start range) (grhssGRHSs grhs)+#else+          grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)+#endif+          case unLoc grhs of+            GRHS _ _ bd -> findSigOfExpr (unLoc bd)+        ]+#endif++    findSigOfExpr :: HsExpr p -> Maybe (Sig p)+    findSigOfExpr = go+      where+#if MIN_VERSION_ghc(9,3,0)+        go (HsLet _ _ binds _ _) = findSigOfBinds range binds+#else+        go (HsLet _ binds _) = findSigOfBinds range binds+#endif+        go (HsDo _ _ stmts) = do+          stmtlr <- unLoc <$> findDeclContainingLoc (_start range) (unLoc stmts)+          case stmtlr of+            LetStmt _ lhsLocalBindsLR -> findSigOfBinds range lhsLocalBindsLR+            _                         -> Nothing+        go _ = Nothing++findSigOfBinds :: p ~ GhcPass p0 => Range -> HsLocalBinds p -> Maybe (Sig p)+findSigOfBinds range = go+  where+    go (HsValBinds _ (ValBinds _ binds lsigs)) =+        case unLoc <$> findDeclContainingLoc (_start range) lsigs of+          Just sig' -> Just sig'+          Nothing -> do+            lHsBindLR <- findDeclContainingLoc (_start range) (bagToList binds)+            findSigOfBind range (unLoc lHsBindLR)+    go _ = Nothing++findInstanceHead :: (Outputable (HsType p), p ~ GhcPass p0) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p)+findInstanceHead df instanceHead decls =+  listToMaybe+#if !MIN_VERSION_ghc(9,2,0)+    [ hsib_body+      | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB {hsib_body}})) <- decls,+        showSDoc df (ppr hsib_body) == instanceHead+    ]+#else+    [ hsib_body+      | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig {sig_body = hsib_body})})) <- decls,+        showSDoc df (ppr hsib_body) == instanceHead+    ]+#endif++#if MIN_VERSION_ghc(9,2,0)+findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e)+#else+findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e)+#endif+findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l)++-- Single:+-- This binding for ‘mod’ shadows the existing binding+--   imported from ‘Prelude’ at haskell-language-server/ghcide/src/Development/IDE/Plugin/CodeAction.hs:10:8-40+--   (and originally defined in ‘GHC.Real’)typecheck(-Wname-shadowing)+-- Multi:+--This binding for ‘pack’ shadows the existing bindings+--  imported from ‘Data.ByteString’ at B.hs:6:1-22+--  imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27+--  imported from ‘Data.Text’ at B.hs:7:1-16+#if !MIN_VERSION_ghc(9,3,0)+suggestHideShadow :: Annotated ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]+suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range}+  | Just [identifier, modName, s] <-+      matchRegexUnifySpaces+        _message+        "This binding for ‘([^`]+)’ shadows the existing binding imported from ‘([^`]+)’ at ([^ ]*)" =+    suggests identifier modName s+  | Just [identifier] <-+      matchRegexUnifySpaces+        _message+        "This binding for ‘([^`]+)’ shadows the existing bindings",+    Just matched <- allMatchRegexUnifySpaces _message "imported from ‘([^’]+)’ at ([^ ]*)",+    mods <- [(modName, s) | [_, modName, s] <- matched],+    result <- nubOrdBy (compare `on` fst) $ mods >>= uncurry (suggests identifier),+    hideAll <- ("Hide " <> identifier <> " from all occurence imports", concat $ snd <$> result) =+    result <> [hideAll]+  | otherwise = []+  where+    L _ HsModule {hsmodImports} = astA ps+ +    suggests identifier modName s+      | Just tcM <- mTcM,+        Just har <- mHar,+        [s'] <- [x | (x, "") <- readSrcSpan $ T.unpack s],+        isUnusedImportedId tcM har (T.unpack identifier) (T.unpack modName) (RealSrcSpan s' Nothing),+        mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName,+        title <- "Hide " <> identifier <> " from " <> modName =+        if modName == "Prelude" && null mDecl+          then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps fileContents+          else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl+      | otherwise = []+#endif++findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)+findImportDeclByModuleName decls modName = flip find decls $ \case+  (L _ ImportDecl {..}) -> modName == moduleNameString (unLoc ideclName)+  _                     -> error "impossible"++isTheSameLine :: SrcSpan -> SrcSpan -> Bool+isTheSameLine s1 s2+  | Just sl1 <- getStartLine s1,+    Just sl2 <- getStartLine s2 =+    sl1 == sl2+  | otherwise = False+  where+    getStartLine x = srcLocLine . realSrcSpanStart <$> realSpan x++isUnusedImportedId :: TcModuleResult -> HieAstResult -> String -> String -> SrcSpan -> Bool+isUnusedImportedId+  TcModuleResult {tmrTypechecked = TcGblEnv {tcg_imports = ImportAvails {imp_mods}}}+  HAR {refMap}+  identifier+  modName+  importSpan+    | occ <- mkVarOcc identifier,+      impModsVals <- importedByUser . concat $ moduleEnvElts imp_mods,+      Just rdrEnv <-+        listToMaybe+          [ imv_all_exports+            | ImportedModsVal {..} <- impModsVals,+              imv_name == mkModuleName modName,+              isTheSameLine imv_span importSpan+          ],+      [GRE {gre_name = name}] <- lookupGlobalRdrEnv rdrEnv occ,+      importedIdentifier <- Right name,+      refs <- M.lookup importedIdentifier refMap =+      maybe True (not . any (\(_, IdentifierDetails {..}) -> identInfo == S.singleton Use)) refs+    | otherwise = False++suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]+suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _  HsModule{hsmodImports}} contents Diagnostic{_range=_range,..}+--     The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant+    | Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"+    , Just (L _ impDecl) <- find (\(L (locA -> l) _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports+    , Just c <- contents+    , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings)+    , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T.unpack c) (concat ranges)+    , not (null ranges')+    = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )]++-- File.hs:16:1: warning:+--     The import of `Data.List' is redundant+--       except perhaps to import instances from `Data.List'+--     To import instances alone, use: import Data.List()+    | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String)+        = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]+    | otherwise = []++caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction]+caRemoveRedundantImports m contents digs ctxDigs uri+  | Just pm <- m,+    r <- join $ map (\d -> repeat d `zip` suggestRemoveRedundantImport pm contents d) digs,+    allEdits <- [ e | (_, (_, edits)) <- r, e <- edits],+    caRemoveAll <- removeAll allEdits,+    ctxEdits <- [ x | x@(d, _) <- r, d `elem` ctxDigs],+    not $ null ctxEdits,+    caRemoveCtx <- map (\(d, (title, tedit)) -> removeSingle title tedit d) ctxEdits+      = caRemoveCtx ++ [caRemoveAll]+  | otherwise = []+  where+    removeSingle title tedit diagnostic = mkCA title (Just CodeActionQuickFix) Nothing [diagnostic] WorkspaceEdit{..} where+        _changes = Just $ Map.singleton uri $ List tedit+        _documentChanges = Nothing+        _changeAnnotations = Nothing+    removeAll tedit = InR $ CodeAction{..} where+        _changes = Just $ Map.singleton uri $ List tedit+        _title = "Remove all redundant imports"+        _kind = Just CodeActionQuickFix+        _diagnostics = Nothing+        _documentChanges = Nothing+        _edit = Just WorkspaceEdit{..}+        _isPreferred = Nothing+        _command = Nothing+        _disabled = Nothing+        _xdata = Nothing+        _changeAnnotations = Nothing++caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction]+caRemoveInvalidExports m contents digs ctxDigs uri+  | Just pm <- m,+    Just txt <- contents,+    txt' <- indexedByPosition $ T.unpack txt,+    r <- mapMaybe (groupDiag pm) digs,+    r' <- map (\(t,d,rs) -> (t,d,extend txt' rs)) r,+    caRemoveCtx <- mapMaybe removeSingle r',+    allRanges <- nubOrd $ [ range | (_,_,ranges) <- r, range <- ranges],+    allRanges' <- extend txt' allRanges,+    Just caRemoveAll <- removeAll allRanges',+    ctxEdits <- [ x | x@(_, d, _) <- r, d `elem` ctxDigs],+    not $ null ctxEdits+      = caRemoveCtx ++ [caRemoveAll]+  | otherwise = []+  where+    extend txt ranges = extendAllToIncludeCommaIfPossible True txt ranges++    groupDiag pm dig+      | Just (title, ranges) <- suggestRemoveRedundantExport pm dig+      = Just (title, dig, ranges)+      | otherwise = Nothing++    removeSingle (_, _, []) = Nothing+    removeSingle (title, diagnostic, ranges) = Just $ InR $ CodeAction{..} where+        tedit = concatMap (\r -> [TextEdit r ""]) $ nubOrd ranges+        _changes = Just $ Map.singleton uri $ List tedit+        _title = title+        _kind = Just CodeActionQuickFix+        _diagnostics = Just $ List [diagnostic]+        _documentChanges = Nothing+        _edit = Just WorkspaceEdit{..}+        _command = Nothing+        _isPreferred = Nothing+        _disabled = Nothing+        _xdata = Nothing+        _changeAnnotations = Nothing+    removeAll [] = Nothing+    removeAll ranges = Just $ InR $ CodeAction{..} where+        tedit = concatMap (\r -> [TextEdit r ""]) ranges+        _changes = Just $ Map.singleton uri $ List tedit+        _title = "Remove all redundant exports"+        _kind = Just CodeActionQuickFix+        _diagnostics = Nothing+        _documentChanges = Nothing+        _edit = Just WorkspaceEdit{..}+        _command = Nothing+        _isPreferred = Nothing+        _disabled = Nothing+        _xdata = Nothing+        _changeAnnotations = Nothing++suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T.Text, [Range])+suggestRemoveRedundantExport ParsedModule{pm_parsed_source = L _ HsModule{..}} Diagnostic{..}+  | msg <- unifySpaces _message+  , Just export <- hsmodExports+  , Just exportRange <- getLocatedRange $ reLoc export+  , exports <- unLoc export+  , Just (removeFromExport, !ranges) <- fmap (getRanges exports . notInScope) (extractNotInScopeName msg)+                         <|> (,[_range]) <$> matchExportItem msg+                         <|> (,[_range]) <$> matchDupExport msg+  , subRange _range exportRange+    = Just ("Remove ‘" <> removeFromExport <> "’ from export", ranges)+  where+    matchExportItem msg = regexSingleMatch msg "The export item ‘([^’]+)’"+    matchDupExport msg = regexSingleMatch msg "Duplicate ‘([^’]+)’ in export list"+    getRanges exports txt = case smallerRangesForBindingExport exports (T.unpack txt) of+      []     -> (txt, [_range])+      ranges -> (txt, ranges)+suggestRemoveRedundantExport _ _ = Nothing++suggestDeleteUnusedBinding :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]+suggestDeleteUnusedBinding+  ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}}+  contents+  Diagnostic{_range=_range,..}+-- Foo.hs:4:1: warning: [-Wunused-binds] Defined but not used: ‘f’+    | Just [name] <- matchRegexUnifySpaces _message ".*Defined but not used: ‘([^ ]+)’"+    , Just indexedContent <- indexedByPosition . T.unpack <$> contents+      = let edits = flip TextEdit "" <$> relatedRanges indexedContent (T.unpack name)+        in ([("Delete ‘" <> name <> "’", edits) | not (null edits)])+    | otherwise = []+    where+      relatedRanges indexedContent name =+        concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDecls+      toRange = realSrcSpanToRange+      extendForSpaces = extendToIncludePreviousNewlineIfPossible++      findRelatedSpans :: PositionIndexedString -> String -> Located (HsDecl GhcPs) -> [Range]+      findRelatedSpans+        indexedContent+        name+        (L (RealSrcSpan l _) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) =+        case lname of+          (L nLoc _name) | isTheBinding nLoc ->+            let findSig (L (RealSrcSpan l _) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig+                findSig _ = []+            in+              extendForSpaces indexedContent (toRange l) :+              concatMap (findSig . reLoc) hsmodDecls+          _ -> concatMap (findRelatedSpanForMatch indexedContent name) matches+      findRelatedSpans _ _ _ = []++      extractNameAndMatchesFromFunBind+        :: HsBind GhcPs+        -> Maybe (Located (IdP GhcPs), [LMatch GhcPs (LHsExpr GhcPs)])+      extractNameAndMatchesFromFunBind+        FunBind+          { fun_id=lname+          , fun_matches=MG {mg_alts=L _ matches}+          } = Just (reLoc lname, matches)+      extractNameAndMatchesFromFunBind _ = Nothing++      findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range]+      findRelatedSigSpan indexedContent name l sig =+        let maybeSpan = findRelatedSigSpan1 name sig+        in case maybeSpan of+          Just (_span, True) -> pure $ extendForSpaces indexedContent $ toRange l -- a :: Int+          Just (RealSrcSpan span _, False) -> pure $ toRange span -- a, b :: Int, a is unused+          _ -> []++      -- Second of the tuple means there is only one match+      findRelatedSigSpan1 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool)+      findRelatedSigSpan1 name (TypeSig _ lnames _) =+        let maybeIdx = findIndex (\(L _ id) -> isSameName id name) lnames+        in case maybeIdx of+            Nothing -> Nothing+            Just _ | length lnames == 1 -> Just (getLoc $ reLoc $ head lnames, True)+            Just idx ->+              let targetLname = getLoc $ reLoc $ lnames !! idx+                  startLoc = srcSpanStart targetLname+                  endLoc = srcSpanEnd targetLname+                  startLoc' = if idx == 0+                              then startLoc+                              else srcSpanEnd . getLoc . reLoc $ lnames !! (idx - 1)+                  endLoc' = if idx == 0 && idx < length lnames - 1+                            then srcSpanStart . getLoc . reLoc $ lnames !! (idx + 1)+                            else endLoc+              in Just (mkSrcSpan startLoc' endLoc', False)+      findRelatedSigSpan1 _ _ = Nothing++      -- for where clause+      findRelatedSpanForMatch+        :: PositionIndexedString+        -> String+        -> LMatch GhcPs (LHsExpr GhcPs)+        -> [Range]+      findRelatedSpanForMatch+        indexedContent+        name+        (L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do+        let go bag lsigs =+                if isEmptyBag bag+                then []+                else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag+#if !MIN_VERSION_ghc(9,2,0)+        case grhssLocalBinds of+          (L _ (HsValBinds _ (ValBinds _ bag lsigs))) -> go bag lsigs+          _                                           -> []+#else+        case grhssLocalBinds of+          (HsValBinds _ (ValBinds _ bag lsigs)) -> go bag lsigs+          _                                     -> []+#endif+      findRelatedSpanForMatch _ _ _ = []++      findRelatedSpanForHsBind+        :: PositionIndexedString+        -> String+        -> [LSig GhcPs]+        -> LHsBind GhcPs+        -> [Range]+      findRelatedSpanForHsBind+        indexedContent+        name+        lsigs+        (L (locA -> (RealSrcSpan l _)) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) =+        if isTheBinding (getLoc lname)+        then+          let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig+              findSig _ = []+          in extendForSpaces indexedContent (toRange l) : concatMap (findSig . reLoc) lsigs+        else concatMap (findRelatedSpanForMatch indexedContent name) matches+      findRelatedSpanForHsBind _ _ _ _ = []++      isTheBinding :: SrcSpan -> Bool+      isTheBinding span = srcSpanToRange span == Just _range++      isSameName :: IdP GhcPs -> String -> Bool+      isSameName x name = T.unpack (printOutputable x) == name++data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll+  deriving (Eq)++getLocatedRange :: HasSrcSpan a => a -> Maybe Range+getLocatedRange = srcSpanToRange . getLoc++suggestExportUnusedTopBinding :: Maybe T.Text -> ParsedModule -> Diagnostic -> Maybe (T.Text, TextEdit)+suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModule{..}} Diagnostic{..}+-- Foo.hs:4:1: warning: [-Wunused-top-binds] Defined but not used: ‘f’+-- Foo.hs:5:1: warning: [-Wunused-top-binds] Defined but not used: type constructor or class ‘F’+-- Foo.hs:6:1: warning: [-Wunused-top-binds] Defined but not used: data constructor ‘Bar’+  | Just source <- srcOpt+  , Just [_, name] <-+      matchRegexUnifySpaces+        _message+        ".*Defined but not used: (type constructor or class |data constructor )?‘([^ ]+)’"+  , Just (exportType, _) <-+      find (matchWithDiagnostic _range . snd)+      . mapMaybe (\(L l b) -> if isTopLevel (locA l) then exportsAs b else Nothing)+      $ hsmodDecls+  , Just exports       <- fmap (fmap reLoc) . reLoc <$> hsmodExports+  , Just exportsEndPos <- _end <$> getLocatedRange exports+  , let name'          = printExport exportType name+        sep            = exportSep source $ map getLocatedRange <$> exports+        exportName     = case sep of+          Nothing -> (if needsComma source exports then ", " else "") <> name'+          Just  s -> s <> name'+        exportsEndPos' = exportsEndPos { _character = pred $ _character exportsEndPos }+        insertPos      = fromMaybe exportsEndPos' $ case (sep, unLoc exports) of+          (Just _, exports'@(_:_)) -> fmap _end . getLocatedRange $ last exports'+          _                        -> Nothing+  = Just ("Export ‘" <> name <> "’", TextEdit (Range insertPos insertPos) exportName)+  | otherwise = Nothing+  where+    exportSep :: T.Text -> Located [Maybe Range] -> Maybe T.Text+    exportSep src (L (RealSrcSpan _ _) xs@(_ : tl@(_ : _))) =+      case mapMaybe (\(e, s) -> (,) <$> e <*> s) $ zip (fmap _end <$> xs) (fmap _start <$> tl) of+        []     -> Nothing+        bounds -> Just smallestSep+          where+            smallestSep+              = snd+              $ minimumBy (comparing fst)+              $ map (T.length &&& id)+              $ nubOrd+              $ map (\(prevEnd, nextStart) -> textInRange (Range prevEnd nextStart) src) bounds+    exportSep _   _ = Nothing++    -- We get the last export and the closing bracket and check for comma in that range.+    needsComma :: T.Text -> Located [Located (IE GhcPs)] -> Bool+    needsComma _ (L _ []) = False+    needsComma source (L (RealSrcSpan l _) exports) =+      let closeParen = _end $ realSrcSpanToRange l+          lastExport = fmap _end . getLocatedRange $ last exports+      in+      case lastExport of+        Just lastExport ->+          not $ T.any (== ',') $ textInRange (Range lastExport closeParen) source+        _ -> False+    needsComma _ _ = False++    opLetter :: T.Text+    opLetter = ":!#$%&*+./<=>?@\\^|-~"++    parenthesizeIfNeeds :: Bool -> T.Text -> T.Text+    parenthesizeIfNeeds needsTypeKeyword x+      | T.any (c ==) opLetter = (if needsTypeKeyword then "type " else "") <> "(" <> x <> ")"+      | otherwise = x+      where+        c = T.head x++    matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool+    matchWithDiagnostic Range{_start=l,_end=r} x =+      let loc = fmap _start . getLocatedRange $ x+       in loc >= Just l && loc <= Just r++    printExport :: ExportsAs -> T.Text -> T.Text+    printExport ExportName x    = parenthesizeIfNeeds False x+    printExport ExportPattern x = "pattern " <> x+    printExport ExportFamily x  = parenthesizeIfNeeds True x+    printExport ExportAll x     = parenthesizeIfNeeds True x <> "(..)"++    isTopLevel :: SrcSpan -> Bool+    isTopLevel span = fmap (_character . _start) (srcSpanToRange span) == Just 0++    exportsAs :: HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs))+    exportsAs (ValD _ FunBind {fun_id})          = Just (ExportName, reLoc fun_id)+    exportsAs (ValD _ (PatSynBind _ PSB {psb_id})) = Just (ExportPattern, reLoc psb_id)+    exportsAs (TyClD _ SynDecl{tcdLName})      = Just (ExportName, reLoc tcdLName)+    exportsAs (TyClD _ DataDecl{tcdLName})     = Just (ExportAll, reLoc tcdLName)+    exportsAs (TyClD _ ClassDecl{tcdLName})    = Just (ExportAll, reLoc tcdLName)+    exportsAs (TyClD _ FamDecl{tcdFam})        = Just (ExportFamily, reLoc $ fdLName tcdFam)+    exportsAs _                                = Nothing++suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]+suggestAddTypeAnnotationToSatisfyContraints sourceOpt Diagnostic{_range=_range,..}+-- File.hs:52:41: warning:+--     * Defaulting the following constraint to type ‘Integer’+--        Num p0 arising from the literal ‘1’+--     * In the expression: 1+--       In an equation for ‘f’: f = 1+-- File.hs:52:41: warning:+--     * Defaulting the following constraints to type ‘[Char]’+--        (Show a0)+--          arising from a use of ‘traceShow’+--          at A.hs:228:7-25+--        (IsString a0)+--          arising from the literal ‘"debug"’+--          at A.hs:228:17-23+--     * In the expression: traceShow "debug" a+--       In an equation for ‘f’: f a = traceShow "debug" a+-- File.hs:52:41: warning:+--     * Defaulting the following constraints to type ‘[Char]’+--         (Show a0)+--          arising from a use of ‘traceShow’+--          at A.hs:255:28-43+--        (IsString a0)+--          arising from the literal ‘"test"’+--          at /Users/serhiip/workspace/ghcide/src/Development/IDE/Plugin/CodeAction.hs:255:38-43+--     * In the fourth argument of ‘seq’, namely ‘(traceShow "test")’+--       In the expression: seq "test" seq "test" (traceShow "test")+--       In an equation for ‘f’:+--          f = seq "test" seq "test" (traceShow "test")+    | Just [ty, lit] <- matchRegexUnifySpaces _message (pat False False True False)+                        <|> matchRegexUnifySpaces _message (pat False False False True)+                        <|> matchRegexUnifySpaces _message (pat False False False False)+            = codeEdit ty lit (makeAnnotatedLit ty lit)+    | Just source <- sourceOpt+    , Just [ty, lit] <- matchRegexUnifySpaces _message (pat True True False False)+            = let lit' = makeAnnotatedLit ty lit;+                  tir = textInRange _range source+              in codeEdit ty lit (T.replace lit lit' tir)+    | otherwise = []+    where+      makeAnnotatedLit ty lit = "(" <> lit <> " :: " <> ty <> ")"+      pat multiple at inArg inExpr = T.concat [ ".*Defaulting the following constraint"+                                       , if multiple then "s" else ""+                                       , " to type ‘([^ ]+)’ "+                                       , ".*arising from the literal ‘(.+)’"+                                       , if inArg then ".+In the.+argument" else ""+                                       , if at then ".+at" else ""+                                       , if inExpr then ".+In the expression" else ""+                                       , ".+In the expression"+                                       ]+      codeEdit ty lit replacement =+        let title = "Add type annotation ‘" <> ty <> "’ to ‘" <> lit <> "’"+            edits = [TextEdit _range replacement]+        in  [( title, edits )]+++suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]+suggestReplaceIdentifier contents Diagnostic{_range=_range,..}+-- File.hs:52:41: error:+--     * Variable not in scope:+--         suggestAcion :: Maybe T.Text -> Range -> Range+--     * Perhaps you meant ‘suggestAction’ (line 83)+-- File.hs:94:37: error:+--     Not in scope: ‘T.isPrfixOf’+--     Perhaps you meant one of these:+--       ‘T.isPrefixOf’ (imported from Data.Text),+--       ‘T.isInfixOf’ (imported from Data.Text),+--       ‘T.isSuffixOf’ (imported from Data.Text)+--     Module ‘Data.Text’ does not export ‘isPrfixOf’.+    | renameSuggestions@(_:_) <- extractRenamableTerms _message+        = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]+    | otherwise = []++suggestNewDefinition :: IdeOptions -> ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]+suggestNewDefinition ideOptions parsedModule contents Diagnostic{_message, _range}+--     * Variable not in scope:+--         suggestAcion :: Maybe T.Text -> Range -> Range+    | Just [name, typ] <- matchRegexUnifySpaces message "Variable not in scope: ([^ ]+) :: ([^*•]+)"+    = newDefinitionAction ideOptions parsedModule _range name typ+    | Just [name, typ] <- matchRegexUnifySpaces message "Found hole: _([^ ]+) :: ([^*•]+) Or perhaps"+    , [(label, newDefinitionEdits)] <- newDefinitionAction ideOptions parsedModule _range name typ+    = [(label, mkRenameEdit contents _range name : newDefinitionEdits)]+    | otherwise = []+    where+      message = unifySpaces _message++newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text -> [(T.Text, [TextEdit])]+newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ+    | Range _ lastLineP : _ <-+      [ realSrcSpanToRange sp+      | (L (locA -> l@(RealSrcSpan sp _)) _) <- hsmodDecls+      , _start `isInsideSrcSpan` l]+    , nextLineP <- Position{ _line = _line lastLineP + 1, _character = 0}+    = [ ("Define " <> sig+        , [TextEdit (Range nextLineP nextLineP) (T.unlines ["", sig, name <> " = _"])]+        )]+    | otherwise = []+  where+    colon = if optNewColonConvention then " : " else " :: "+    sig = name <> colon <> T.dropWhileEnd isSpace typ+    ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}} = parsedModule++suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)]+suggestFillTypeWildcard Diagnostic{_range=_range,..}+-- Foo.hs:3:8: error:+--     * Found type wildcard `_' standing for `p -> p1 -> p'++    | "Found type wildcard" `T.isInfixOf` _message+    , " standing for " `T.isInfixOf` _message+    , typeSignature <- extractWildCardTypeSignature _message+        =  [("Use type signature: ‘" <> typeSignature <> "’", TextEdit _range typeSignature)]+    | otherwise = []++{- Handles two variants with different formatting++1. Could not find module ‘Data.Cha’+   Perhaps you meant Data.Char (from base-4.12.0.0)++2. Could not find module ‘Data.I’+   Perhaps you meant+      Data.Ix (from base-4.14.3.0)+      Data.Eq (from base-4.14.3.0)+      Data.Int (from base-4.14.3.0)+-}+suggestModuleTypo :: Diagnostic -> [(T.Text, TextEdit)]+suggestModuleTypo Diagnostic{_range=_range,..}+    | "Could not find module" `T.isInfixOf` _message =+      case T.splitOn "Perhaps you meant" _message of+          [_, stuff] ->+              [ ("replace with " <> modul, TextEdit _range modul)+              | modul <- mapMaybe extractModule (T.lines stuff)+              ]+          _ -> []+    | otherwise = []+  where+    extractModule line = case T.words line of+        [modul, "(from", _] -> Just modul+        _                   -> Nothing+++suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)]+suggestFillHole Diagnostic{_range=_range,..}+    | Just holeName <- extractHoleName _message+    , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) =+      let isInfixHole = _message =~ addBackticks holeName :: Bool in+        map (proposeHoleFit holeName False isInfixHole) holeFits+        ++ map (proposeHoleFit holeName True isInfixHole) refFits+    | otherwise = []+    where+      extractHoleName = fmap head . flip matchRegexUnifySpaces "Found hole: ([^ ]*)"+      addBackticks text = "`" <> text <> "`"+      addParens text = "(" <> text <> ")"+      proposeHoleFit holeName parenthise isInfixHole name =+        let isInfixOperator = T.head name == '('+            name' = getOperatorNotation isInfixHole isInfixOperator name in+          ( "replace " <> holeName <> " with " <> name+          , TextEdit _range (if parenthise then addParens name' else name')+          )+      getOperatorNotation True False name                    = addBackticks name+      getOperatorNotation True True name                     = T.drop 1 (T.dropEnd 1 name)+      getOperatorNotation _isInfixHole _isInfixOperator name = name++processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text])+processHoleSuggestions mm = (holeSuggestions, refSuggestions)+{-+    • Found hole: _ :: LSP.Handlers++      Valid hole fits include def+      Valid refinement hole fits include+        fromMaybe (_ :: LSP.Handlers) (_ :: Maybe LSP.Handlers)+        fromJust (_ :: Maybe LSP.Handlers)+        haskell-lsp-types-0.22.0.0:Language.LSP.Types.Window.$sel:_value:ProgressParams (_ :: ProgressParams+                                                                                                        LSP.Handlers)+        T.foldl (_ :: LSP.Handlers -> Char -> LSP.Handlers)+                (_ :: LSP.Handlers)+                (_ :: T.Text)+        T.foldl' (_ :: LSP.Handlers -> Char -> LSP.Handlers)+                 (_ :: LSP.Handlers)+                 (_ :: T.Text)+-}+  where+    t = id @T.Text+    holeSuggestions = do+      -- get the text indented under Valid hole fits+      validHolesSection <-+        getIndentedGroupsBy (=~ t " *Valid (hole fits|substitutions) include") mm+      -- the Valid hole fits line can contain a hole fit+      holeFitLine <-+        mapHead+            (mrAfter . (=~ t " *Valid (hole fits|substitutions) include"))+            validHolesSection+      let holeFit = T.strip $ T.takeWhile (/= ':') holeFitLine+      guard (not $ T.null holeFit)+      return holeFit+    refSuggestions = do -- @[]+      -- get the text indented under Valid refinement hole fits+      refinementSection <-+        getIndentedGroupsBy (=~ t " *Valid refinement hole fits include") mm+      -- get the text for each hole fit+      holeFitLines <- getIndentedGroups (tail refinementSection)+      let holeFit = T.strip $ T.unwords holeFitLines+      guard $ not $ holeFit =~ t "Some refinement hole fits suppressed"+      return holeFit++    mapHead f (a:aa) = f a : aa+    mapHead _ []     = []++-- > getIndentedGroups [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1,", "  l1", "  l2"], [" H2", "  l3"]]+getIndentedGroups :: [T.Text] -> [[T.Text]]+getIndentedGroups [] = []+getIndentedGroups ll@(l:_) = getIndentedGroupsBy ((== indentation l) . indentation) ll+-- |+-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1", "  l1", "  l2"], [" H2", "  l3"]]+getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]+getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of+    (l:ll) -> case span (\l' -> indentation l < indentation l') ll of+        (indented, rest) -> (l:indented) : getIndentedGroupsBy pred rest+    _ -> []++indentation :: T.Text -> Int+indentation = T.length . T.takeWhile isSpace++#if !MIN_VERSION_ghc(9,3,0)+suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)]+suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}+    | Just [binding, mod, srcspan] <-+      matchRegexUnifySpaces _message+      "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$"+    = suggestions hsmodImports binding mod srcspan+    | Just (binding, mod_srcspan) <-+      matchRegExMultipleImports _message+    = mod_srcspan >>= uncurry (suggestions hsmodImports binding)+    | otherwise = []+    where+        canUseDatacon = case extractNotInScopeName _message of+                            Just NotInScopeTypeConstructorOrClass{} -> False+                            _                                       -> True++        suggestions decls binding mod srcspan+          | range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of+                [s] -> let x = realSrcSpanToRange s+                   in x{_end = (_end x){_character = succ (_character (_end x))}}+                _ -> error "bug in srcspan parser",+            Just decl <- findImportDeclByRange decls range,+            Just ident <- lookupExportMap binding mod+          = [ ( "Add " <> renderImportStyle importStyle <> " to the import list of " <> mod+              , quickFixImportKind' "extend" importStyle+              , uncurry extendImport (unImportStyle importStyle) decl+              )+            | importStyle <- NE.toList $ importStyles ident+            ]+          | otherwise = []+        lookupExportMap binding mod+          | Just match <- Map.lookup binding (getExportsMap exportsMap)+          -- Only for the situation that data constructor name is same as type constructor name,+          -- let ident with parent be in front of the one without.+          , sortedMatch <- sortBy (\ident1 ident2 -> parent ident2 `compare` parent ident1) (Set.toList match)+          , idents <- filter (\ident -> moduleNameText ident == mod && (canUseDatacon || not (isDatacon ident))) sortedMatch+          , (not . null) idents -- Ensure fallback while `idents` is empty+          , ident <- head idents+          = Just ident++            -- fallback to using GHC suggestion even though it is not always correct+          | otherwise+          = Just IdentInfo+                { name = mkVarOcc $ T.unpack binding+                , rendered = binding+                , parent = Nothing+                , isDatacon = False+                , moduleNameText = mod}+#endif++data HidingMode+    = HideOthers [ModuleTarget]+    | ToQualified+        Bool+        -- ^ Parenthesised?+        ModuleName++data ModuleTarget+    = ExistingImp (NonEmpty (LImportDecl GhcPs))+    | ImplicitPrelude [LImportDecl GhcPs]++targetImports :: ModuleTarget -> [LImportDecl GhcPs]+targetImports (ExistingImp ne)     = NE.toList ne+targetImports (ImplicitPrelude xs) = xs++oneAndOthers :: [a] -> [(a, [a])]+oneAndOthers = go+    where+        go []       = []+        go (x : xs) = (x, xs) : map (second (x :)) (go xs)++isPreludeImplicit :: DynFlags -> Bool+isPreludeImplicit = xopt Lang.ImplicitPrelude++#if !MIN_VERSION_ghc(9,3,0)+-- | Suggests disambiguation for ambiguous symbols.+suggestImportDisambiguation ::+    DynFlags ->+    Maybe T.Text ->+    Annotated ParsedSource ->+    T.Text ->+    Diagnostic ->+    [(T.Text, [Either TextEdit Rewrite])]+suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..}+    | Just [ambiguous] <-+        matchRegexUnifySpaces+            _message+            "Ambiguous occurrence ‘([^’]+)’"+      , Just modules <-+            map last+                <$> allMatchRegexUnifySpaces _message "imported from ‘([^’]+)’"+      , local <- matchRegexUnifySpaces _message "defined at .+:[0-9]+:[0-9]+" =+        suggestions ambiguous modules (isJust local)+    | otherwise = []+    where+        L _ HsModule {hsmodImports} = astA ps++        locDic =+            fmap (NE.fromList . DL.toList) $+            Map.fromListWith (<>) $+                map+                    ( \i@(L _ idecl) ->+                        ( T.pack $ moduleNameString $ unLoc $ ideclName idecl+                        , DL.singleton i+                        )+                    )+                    hsmodImports+        toModuleTarget "Prelude"+            | isPreludeImplicit df+             = Just $ ImplicitPrelude $+                maybe [] NE.toList (Map.lookup "Prelude" locDic)+        toModuleTarget mName = ExistingImp <$> Map.lookup mName locDic+        parensed =+            "(" `T.isPrefixOf` T.strip (textInRange _range txt)+        -- > removeAllDuplicates [1, 1, 2, 3, 2] = [3]+        removeAllDuplicates = map head . filter ((==1) <$> length) . group . sort+        hasDuplicate xs = length xs /= length (S.fromList xs)+        suggestions symbol mods local+          | hasDuplicate mods = case mapM toModuleTarget (removeAllDuplicates mods) of+                                  Just targets -> suggestionsImpl symbol (map (, []) targets) local+                                  Nothing      -> []+          | otherwise         = case mapM toModuleTarget mods of+                                  Just targets -> suggestionsImpl symbol (oneAndOthers targets) local+                                  Nothing      -> []+        suggestionsImpl symbol targetsWithRestImports local =+            sortOn fst+            [ ( renderUniquify mode modNameText symbol False+              , disambiguateSymbol ps fileContents diag symbol mode+              )+            | (modTarget, restImports) <- targetsWithRestImports+            , let modName = targetModuleName modTarget+                  modNameText = T.pack $ moduleNameString modName+            , mode <-+                [ ToQualified parensed qual+                | ExistingImp imps <- [modTarget]+#if MIN_VERSION_ghc(9,0,0)+                {- HLINT ignore suggestImportDisambiguation "Use nubOrd" -}+                -- TODO: The use of nub here is slow and maybe wrong for UnhelpfulLocation+                -- nubOrd can't be used since SrcSpan is intentionally no Ord+                , L _ qual <- nub $ mapMaybe (ideclAs . unLoc)+#else+                , L _ qual <- nubOrd $ mapMaybe (ideclAs . unLoc)+#endif+                    $ NE.toList imps+                ]+                ++ [ToQualified parensed modName+                    | any (occursUnqualified symbol . unLoc)+                        (targetImports modTarget)+                    || case modTarget of+                        ImplicitPrelude{} -> True+                        _                 -> False+                    ]+                ++ [HideOthers restImports | not (null restImports)]+            ] ++ [ ( renderUniquify mode T.empty symbol True+              , disambiguateSymbol ps fileContents diag symbol mode+              ) | local, not (null targetsWithRestImports)+                , let mode = HideOthers (uncurry (:) (head targetsWithRestImports))+            ]+        renderUniquify HideOthers {} modName symbol local =+            "Use " <> (if local then "local definition" else modName) <> " for " <> symbol <> ", hiding other imports"+        renderUniquify (ToQualified _ qual) _ symbol _ =+            "Replace with qualified: "+                <> T.pack (moduleNameString qual)+                <> "."+                <> symbol+suggestImportDisambiguation _ _ _ _ _ = []+#endif++occursUnqualified :: T.Text -> ImportDecl GhcPs -> Bool+occursUnqualified symbol ImportDecl{..}+    | isNothing ideclAs = Just False /=+            -- I don't find this particularly comprehensible,+            -- but HLint suggested me to do so...+        (ideclHiding <&> \(isHiding, L _ ents) ->+            let occurs = any ((symbol `symbolOccursIn`) . unLoc) ents+            in isHiding && not occurs || not isHiding && occurs+        )+occursUnqualified _ _ = False++symbolOccursIn :: T.Text -> IE GhcPs -> Bool+symbolOccursIn symb = any ((== symb). printOutputable) . ieNames++targetModuleName :: ModuleTarget -> ModuleName+targetModuleName ImplicitPrelude{} = mkModuleName "Prelude"+targetModuleName (ExistingImp (L _ ImportDecl{..} :| _)) =+    unLoc ideclName+targetModuleName (ExistingImp _) =+    error "Cannot happen!"++#if !MIN_VERSION_ghc(9,3,0)+disambiguateSymbol ::+    Annotated ParsedSource ->+    T.Text ->+    Diagnostic ->+    T.Text ->+    HidingMode ->+    [Either TextEdit Rewrite]+disambiguateSymbol ps fileContents Diagnostic {..} (T.unpack -> symbol) = \case+    (HideOthers hiddens0) ->+        [ Right $ hideSymbol symbol idecl+        | ExistingImp idecls <- hiddens0+        , idecl <- NE.toList idecls+        ]+            ++ mconcat+                [ if null imps+                    then maybeToList $ Left . snd <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) ps fileContents+                    else Right . hideSymbol symbol <$> imps+                | ImplicitPrelude imps <- hiddens0+                ]+    (ToQualified parensed qualMod) ->+        let occSym = mkVarOcc symbol+            rdr = Qual qualMod occSym+         in Right <$> [ if parensed+                then Rewrite (rangeToSrcSpan "<dummy>" _range) $ \df ->+                    liftParseAST @(HsExpr GhcPs) df $+                    T.unpack $ printOutputable $+                        HsVar @GhcPs noExtField $+                            reLocA $ L (mkGeneralSrcSpan  "") rdr+                else Rewrite (rangeToSrcSpan "<dummy>" _range) $ \df ->+                    liftParseAST @RdrName df $+                    T.unpack $ printOutputable $ L (mkGeneralSrcSpan  "") rdr+            ]+#endif++findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)+findImportDeclByRange xs range = find (\(L (locA -> l) _)-> srcSpanToRange l == Just range) xs++suggestFixConstructorImport :: Diagnostic -> [(T.Text, TextEdit)]+suggestFixConstructorImport Diagnostic{_range=_range,..}+    -- ‘Success’ is a data constructor of ‘Result’+    -- To import it use+    -- import Data.Aeson.Types( Result( Success ) )+    -- or+    -- import Data.Aeson.Types( Result(..) ) (lsp-ui)+  | Just [constructor, typ] <-+    matchRegexUnifySpaces _message+    "‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use"+  = let fixedImport = typ <> "(" <> constructor <> ")"+    in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)]+  | otherwise = []++#if !MIN_VERSION_ghc(9,3,0)+-- | Suggests a constraint for a declaration for which a constraint is missing.+suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]+suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..}+  | Just missingConstraint <- findMissingConstraint _message+  = let codeAction = if _message =~ ("the type signature for:" :: String)+                        then suggestFunctionConstraint df parsedModule+                        else suggestInstanceConstraint df parsedModule+     in codeAction diag missingConstraint+  | otherwise = []+    where+      findMissingConstraint :: T.Text -> Maybe T.Text+      findMissingConstraint t =+        let regex = "(No instance for|Could not deduce) \\((.+)\\) arising from" -- a use of / a do statement+            regexImplicitParams = "Could not deduce: (\\?.+) arising from a use of"+            match = matchRegexUnifySpaces t regex+            matchImplicitParams = matchRegexUnifySpaces t regexImplicitParams+        in match <|> matchImplicitParams <&> last++-- | Suggests a constraint for an instance declaration for which a constraint is missing.+suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]++suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missingConstraint+  | Just instHead <- instanceHead+  = [(actionTitle missingConstraint , appendConstraint (T.unpack missingConstraint) instHead)]+  | otherwise = []+    where+      instanceHead+        -- Suggests a constraint for an instance declaration with no existing constraints.+        -- • No instance for (Eq a) arising from a use of ‘==’+        --   Possible fix: add (Eq a) to the context of the instance declaration+        -- • In the expression: x == y+        --   In an equation for ‘==’: (Wrap x) == (Wrap y) = x == y+        --   In the instance declaration for ‘Eq (Wrap a)’+        | Just [instanceDeclaration] <- matchRegexUnifySpaces _message "In the instance declaration for ‘([^`]*)’"+        , Just instHead <- findInstanceHead df (T.unpack instanceDeclaration) hsmodDecls+        = Just instHead+        -- Suggests a constraint for an instance declaration with one or more existing constraints.+        -- • Could not deduce (Eq b) arising from a use of ‘==’+        --   from the context: Eq a+        --     bound by the instance declaration at /path/to/Main.hs:7:10-32+        --   Possible fix: add (Eq b) to the context of the instance declaration+        -- • In the second argument of ‘(&&)’, namely ‘x' == y'’+        --   In the expression: x == y && x' == y'+        --   In an equation for ‘==’:+        --       (Pair x x') == (Pair y y') = x == y && x' == y'+        | Just [instanceLineStr, constraintFirstCharStr]+            <- matchRegexUnifySpaces _message "bound by the instance declaration at .+:([0-9]+):([0-9]+)"+#if !MIN_VERSION_ghc(9,2,0)+        , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB{hsib_body}})))+#else+        , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig{sig_body = hsib_body})})))+#endif+            <- findDeclContainingLoc (Position (readPositionNumber instanceLineStr) (readPositionNumber constraintFirstCharStr)) hsmodDecls+        = Just hsib_body+        | otherwise+        = Nothing++      readPositionNumber :: T.Text -> UInt+      readPositionNumber = T.unpack >>> read @Integer >>> fromIntegral++      actionTitle :: T.Text -> T.Text+      actionTitle constraint = "Add `" <> constraint+        <> "` to the context of the instance declaration"++suggestImplicitParameter ::+  ParsedSource ->+  Diagnostic ->+  [(T.Text, Rewrite)]+suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _range}+  | Just [implicitT] <- matchRegexUnifySpaces _message "Unbound implicit parameter \\(([^:]+::.+)\\) arising",+    Just (L _ (ValD _ FunBind {fun_id = L _ funId})) <- findDeclContainingLoc (_start _range) hsmodDecls,+#if !MIN_VERSION_ghc(9,2,0)+    Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}})+#else+    Just (TypeSig _ _ HsWC {hswc_body = (unLoc -> HsSig {sig_body = hsib_body})})+#endif+      <- findSigOfDecl (== funId) hsmodDecls+    =+      [( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId)+        , appendConstraint (T.unpack implicitT) hsib_body)]+  | otherwise = []+#endif++findTypeSignatureName :: T.Text -> Maybe T.Text+findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " <&> head++#if !MIN_VERSION_ghc(9,3,0)+-- | Suggests a constraint for a type signature with any number of existing constraints.+suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]++suggestFunctionConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missingConstraint+-- • No instance for (Eq a) arising from a use of ‘==’+--   Possible fix:+--     add (Eq a) to the context of+--       the type signature for:+--         eq :: forall a. a -> a -> Bool+-- • In the expression: x == y+--   In an equation for ‘eq’: eq x y = x == y++-- • Could not deduce (Eq b) arising from a use of ‘==’+--   from the context: Eq a+--     bound by the type signature for:+--                eq :: forall a b. Eq a => Pair a b -> Pair a b -> Bool+--     at Main.hs:5:1-42+--   Possible fix:+--     add (Eq b) to the context of+--       the type signature for:+--         eq :: forall a b. Eq a => Pair a b -> Pair a b -> Bool+-- • In the second argument of ‘(&&)’, namely ‘y == y'’+--   In the expression: x == x' && y == y'+--   In an equation for ‘eq’:+--       eq (Pair x y) (Pair x' y') = x == x' && y == y'+  | Just typeSignatureName <- findTypeSignatureName _message+#if !MIN_VERSION_ghc(9,2,0)+  , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}})+#else+  , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})})+#endif+    <- findSigOfDecl ((T.unpack typeSignatureName ==) . showSDoc df . ppr) hsmodDecls+  , title <- actionTitle missingConstraint typeSignatureName+  = [(title, appendConstraint (T.unpack missingConstraint) sig)]+  | otherwise+  = []+    where+      actionTitle :: T.Text -> T.Text -> T.Text+      actionTitle constraint typeSignatureName = "Add `" <> constraint+        <> "` to the context of the type signature for `" <> typeSignatureName <> "`"++-- | Suggests the removal of a redundant constraint for a type signature.+removeRedundantConstraints :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]+removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..}+-- • Redundant constraint: Eq a+-- • In the type signature for:+--      foo :: forall a. Eq a => a -> a+-- • Redundant constraints: (Monoid a, Show a)+-- • In the type signature for:+--      foo :: forall a. (Num a, Monoid a, Eq a, Show a) => a -> Bool+  -- Account for both "Redundant constraint" and "Redundant constraints".+  | "Redundant constraint" `T.isInfixOf` _message+  , Just typeSignatureName <- findTypeSignatureName _message+#if !MIN_VERSION_ghc(9,2,0)+  , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}})+#else+  , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})})+#endif+    <- fmap(traceAst "redundantConstraint") $ findSigOfDeclRanged _range hsmodDecls+  , Just redundantConstraintList <- findRedundantConstraints _message+  , rewrite <- removeConstraint (toRemove df redundantConstraintList) sig+      = [(actionTitle redundantConstraintList typeSignatureName, rewrite)]+  | otherwise = []+    where+      toRemove df list a = T.pack (showSDoc df (ppr a)) `elem` list++      parseConstraints :: T.Text -> [T.Text]+      parseConstraints t = t+        & (T.strip >>> stripConstraintsParens >>> T.splitOn ",")+        <&> T.strip++      stripConstraintsParens :: T.Text -> T.Text+      stripConstraintsParens constraints =+        if "(" `T.isPrefixOf` constraints+           then constraints & T.drop 1 & T.dropEnd 1 & T.strip+           else constraints++{-+9.2: "message": "/private/var/folders/4m/d38fhm3936x_gy_9883zbq8h0000gn/T/extra-dir-53173393699/Testing.hs:4:1: warning:+    ⢠Redundant constraints: (Eq a, Show a)+    ⢠In the type signature for:+               foo :: forall a. (Eq a, Show a) => a -> Bool",++9.0: "message": "⢠Redundant constraints: (Eq a, Show a)+    ⢠In the type signature for:+           foo :: forall a. (Eq a, Show a) => a -> Bool",+-}+      findRedundantConstraints :: T.Text -> Maybe [T.Text]+      findRedundantConstraints t = t+        & T.lines+        -- In <9.2 it's the first line, in 9.2 it' the second line+        & take 2+        & mapMaybe ((`matchRegexUnifySpaces` "Redundant constraints?: (.+)") . T.strip)+        & listToMaybe+        <&> (head >>> parseConstraints)++      formatConstraints :: [T.Text] -> T.Text+      formatConstraints [] = ""+      formatConstraints [constraint] = constraint+      formatConstraints constraintList = constraintList+        & T.intercalate ", "+        & \cs -> "(" <> cs <> ")"++      actionTitle :: [T.Text] -> T.Text -> T.Text+      actionTitle constraintList typeSignatureName =+        "Remove redundant constraint" <> (if length constraintList == 1 then "" else "s") <> " `"+        <> formatConstraints constraintList+        <> "` from the context of the type signature for `" <> typeSignatureName <> "`"++-------------------------------------------------------------------------------------------------++suggestNewOrExtendImportForClassMethod :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])]+suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnostic {_message}+  | Just [methodName, className] <-+      matchRegexUnifySpaces+        _message+        "‘([^’]*)’ is not a \\(visible\\) method of class ‘([^’]*)’",+    idents <-+      maybe [] (Set.toList . Set.filter (\x -> parent x == Just className)) $+        Map.lookup methodName $ getExportsMap packageExportsMap =+    mconcat $ suggest <$> idents+  | otherwise = []+  where+    suggest identInfo@IdentInfo {moduleNameText}+      | importStyle <- NE.toList $ importStyles identInfo,+        mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc . astA $ ps) (T.unpack moduleNameText) =+        case mImportDecl of+          -- extend+          Just decl ->+            [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText,+                quickFixImportKind' "extend" style,+                [Right $ uncurry extendImport (unImportStyle style) decl]+              )+              | style <- importStyle+            ]+          -- new+          _+            | Just (range, indent) <- newImportInsertRange ps fileContents+            ->+             (\(kind, unNewImport -> x) -> (x, kind, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$>+            [ (quickFixImportKind' "new" style, newUnqualImport moduleNameText rendered False)+              | style <- importStyle,+                let rendered = renderImportStyle style+            ]+              <> [(quickFixImportKind "new.all", newImportAll moduleNameText)]+            | otherwise -> []+#endif++suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]+suggestNewImport packageExportsMap ps fileContents Diagnostic{_message}+  | msg <- unifySpaces _message+  , Just thingMissing <- extractNotInScopeName msg+  , qual <- extractQualifiedModuleName msg+  , qual' <-+      extractDoesNotExportModuleName msg+        >>= (findImportDeclByModuleName hsmodImports . T.unpack)+        >>= ideclAs . unLoc+        <&> T.pack . moduleNameString . unLoc+  , Just (range, indent) <- newImportInsertRange ps fileContents+  , extendImportSuggestions <- matchRegexUnifySpaces msg+    "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"+  = sortOn fst3 [(imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))+    | (kind, unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions+    ]+  where+    L _ HsModule {..} = astA ps+suggestNewImport _ _ _ _ = []++constructNewImportSuggestions+  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [(CodeActionKind, NewImport)]+constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrdOn snd+  [ suggestion+  | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing]+  , identInfo <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap)+  , canUseIdent thingMissing identInfo+  , moduleNameText identInfo `notElem` fromMaybe [] notTheseModules+  , suggestion <- renderNewImport identInfo+  ]+ where+  renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)]+  renderNewImport identInfo+    | Just q <- qual+    = [(quickFixImportKind "new.qualified", newQualImport m q)]+    | otherwise+    = [(quickFixImportKind' "new" importStyle, newUnqualImport m (renderImportStyle importStyle) False)+      | importStyle <- NE.toList $ importStyles identInfo] +++      [(quickFixImportKind "new.all", newImportAll m)]+    where+        m = moduleNameText identInfo++newtype NewImport = NewImport {unNewImport :: T.Text}+  deriving (Show, Eq, Ord)++newImportToEdit :: NewImport -> Annotated ParsedSource -> T.Text -> Maybe (T.Text, TextEdit)+newImportToEdit (unNewImport -> imp) ps fileContents+  | Just (range, indent) <- newImportInsertRange ps fileContents+  = Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " "))+  | otherwise = Nothing++-- | Finds the next valid position for inserting a new import declaration+-- * If the file already has existing imports it will be inserted under the last of these,+-- it is assumed that the existing last import declaration is in a valid position+-- * If the file does not have existing imports, but has a (module ... where) declaration,+-- the new import will be inserted directly under this declaration (accounting for explicit exports)+-- * If the file has neither existing imports nor a module declaration,+-- the import will be inserted at line zero if there are no pragmas,+-- * otherwise inserted one line after the last file-header pragma+newImportInsertRange :: Annotated ParsedSource -> T.Text -> Maybe (Range, Int)+newImportInsertRange ps fileContents+  |  Just ((l, c), col) <- case hsmodImports of+      -- When there is no existing imports, we only cares about the line number, setting column and indent to zero.+      [] -> (\line -> ((line, 0), 0)) <$> findPositionNoImports ps fileContents+      _  -> findPositionFromImports (map reLoc hsmodImports) last+  , let insertPos = Position (fromIntegral l) (fromIntegral c)+    = Just (Range insertPos insertPos, col)+  | otherwise = Nothing+  where+    L _ HsModule {..} = astA ps++-- | Find the position for a new import when there isn't an existing one.+-- * If there is a module declaration, a new import should be inserted under the module declaration (including exports list)+-- * Otherwise, a new import should be inserted after any file-header pragma.+findPositionNoImports :: Annotated ParsedSource -> T.Text -> Maybe Int+findPositionNoImports ps fileContents =+    maybe (Just (findNextPragmaPosition fileContents)) (findPositionAfterModuleName ps) hsmodName+  where+    L _ HsModule {..} = astA ps++-- | find line number right after module ... where+findPositionAfterModuleName :: Annotated ParsedSource+#if MIN_VERSION_ghc(9,2,0)+                            -> LocatedA ModuleName+#else+                            -> Located ModuleName+#endif+                            -> Maybe Int+findPositionAfterModuleName ps hsmodName' = do+    -- Note that 'where' keyword and comments are not part of the AST. They belongs to+    -- the exact-print information. To locate it, we need to find the previous AST node,+    -- calculate the gap between it and 'where', then add them up to produce the absolute+    -- position of 'where'.++    lineOffset <- whereKeywordLineOffset -- Calculate the gap before 'where' keyword.+    case prevSrcSpan of+        UnhelpfulSpan _ -> Nothing+        (RealSrcSpan prevSrcSpan' _) ->+            -- add them up produce the absolute location of 'where' keyword+            Just $ srcLocLine (realSrcSpanEnd prevSrcSpan') + lineOffset+  where+    L _ HsModule {..} = astA ps++    -- The last AST node before 'where' keyword. Might be module name or export list.+    prevSrcSpan = maybe (getLoc hsmodName') getLoc hsmodExports++    -- The relative position of 'where' keyword (in lines, relative to the previous AST node).+    -- The exact-print API changed a lot in ghc-9.2, so we need to handle it seperately for different compiler versions.+    whereKeywordLineOffset :: Maybe Int+#if MIN_VERSION_ghc(9,2,0)+    whereKeywordLineOffset = case hsmodAnn of+        EpAnn _ annsModule _ -> do+            -- Find the first 'where'+            whereLocation <- fmap NE.head .  NE.nonEmpty . mapMaybe filterWhere .  am_main $ annsModule+            epaLocationToLine whereLocation+        EpAnnNotUsed -> Nothing+    filterWhere (AddEpAnn AnnWhere loc) = Just loc+    filterWhere _                       = Nothing++    epaLocationToLine :: EpaLocation -> Maybe Int+    epaLocationToLine (EpaSpan sp) = Just . srcLocLine . realSrcSpanEnd $ sp+    epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments+    -- 'priorComments' contains the comments right before the current EpaLocation+    -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and+    -- the current AST node+    epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments)++    sumCommentsOffset :: [LEpaComment] -> Int+    sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor))++    anchorOpLine :: AnchorOperation -> Int+    anchorOpLine UnchangedAnchor                      = 0+    anchorOpLine (MovedAnchor (SameLine _))           = 0+    anchorOpLine (MovedAnchor (DifferentLine line _)) = line+#else+    whereKeywordLineOffset = do+        ann <- annsA ps M.!? mkAnnKey (astA ps)+        deltaPos <- fmap NE.head . NE.nonEmpty .mapMaybe filterWhere $ annsDP ann+        pure $ deltaRow deltaPos++    -- Before ghc 9.2, DeltaPos doesn't take comment into acccount, so we don't need to sum line offset of comments.+    filterWhere :: (KeywordId, DeltaPos) -> Maybe DeltaPos+    filterWhere (keywordId, deltaPos) =+        if keywordId == G AnnWhere then Just deltaPos else Nothing+#endif++findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int)+findPositionFromImports hsField f = case getLoc (f hsField) of+  RealSrcSpan s _ ->+    let col = calcCol s+     in Just ((srcLocLine (realSrcSpanEnd s), col), col)+  _ -> Nothing+  where calcCol s = srcLocCol (realSrcSpanStart s) - 1++-- | Find the position one after the last file-header pragma+-- Defaults to zero if there are no pragmas in file+findNextPragmaPosition :: T.Text -> Int+findNextPragmaPosition contents = lineNumber+  where+    lineNumber = afterLangPragma . afterOptsGhc $ afterShebang+    afterLangPragma = afterPragma "LANGUAGE" contents'+    afterOptsGhc = afterPragma "OPTIONS_GHC" contents'+    afterShebang = lastLineWithPrefix (T.isPrefixOf "#!") contents' 0+    contents' = T.lines contents++afterPragma :: T.Text -> [T.Text] -> Int -> Int+afterPragma name contents lineNum = lastLineWithPrefix (checkPragma name) contents lineNum++lastLineWithPrefix :: (T.Text -> Bool) -> [T.Text] -> Int -> Int+lastLineWithPrefix p contents lineNum = max lineNum next+  where+    next = maybe lineNum succ $ listToMaybe . reverse $ findIndices p contents++checkPragma :: T.Text -> T.Text -> Bool+checkPragma name = check+  where+    check l = isPragma l && getName l == name+    getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l+    isPragma = T.isPrefixOf "{-#"++-- | Construct an import declaration with at most one symbol+newImport+  :: T.Text -- ^ module name+  -> Maybe T.Text -- ^  the symbol+  -> Maybe T.Text -- ^ qualified name+  -> Bool -- ^ the symbol is to be imported or hidden+  -> NewImport+newImport modName mSymbol mQual hiding = NewImport impStmt+  where+     symImp+            | Just symbol <- mSymbol+              , symOcc <- mkVarOcc $ T.unpack symbol =+              " (" <> printOutputable (parenSymOcc symOcc $ ppr symOcc) <> ")"+            | otherwise = ""+     impStmt =+       "import "+         <> maybe "" (const "qualified ") mQual+         <> modName+         <> (if hiding then " hiding" else "")+         <> symImp+         <> maybe "" (\qual -> if modName == qual then "" else " as " <> qual) mQual++newQualImport :: T.Text -> T.Text -> NewImport+newQualImport modName qual = newImport modName Nothing (Just qual) False++newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport+newUnqualImport modName symbol = newImport modName (Just symbol) Nothing++newImportAll :: T.Text -> NewImport+newImportAll modName = newImport modName Nothing Nothing False++hideImplicitPreludeSymbol :: T.Text -> NewImport+hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True++canUseIdent :: NotInScope -> IdentInfo -> Bool+canUseIdent NotInScopeDataConstructor{}        = isDatacon+canUseIdent NotInScopeTypeConstructorOrClass{} = not . isDatacon+canUseIdent _                                  = const True++data NotInScope+    = NotInScopeDataConstructor T.Text+    | NotInScopeTypeConstructorOrClass T.Text+    | NotInScopeThing T.Text+    deriving Show++notInScope :: NotInScope -> T.Text+notInScope (NotInScopeDataConstructor t)        = t+notInScope (NotInScopeTypeConstructorOrClass t) = t+notInScope (NotInScopeThing t)                  = t++extractNotInScopeName :: T.Text -> Maybe NotInScope+extractNotInScopeName x+  | Just [name] <- matchRegexUnifySpaces x "Data constructor not in scope: ([^ ]+)"+  = Just $ NotInScopeDataConstructor name+  | Just [name] <- matchRegexUnifySpaces x "Not in scope: data constructor [^‘]*‘([^’]*)’"+  = Just $ NotInScopeDataConstructor name+  | Just [name] <- matchRegexUnifySpaces x "ot in scope: type constructor or class [^‘]*‘([^’]*)’"+  = Just $ NotInScopeTypeConstructorOrClass name+  | Just [name] <- matchRegexUnifySpaces x "ot in scope: \\(([^‘ ]+)\\)"+  = Just $ NotInScopeThing name+  | Just [name] <- matchRegexUnifySpaces x "ot in scope: ([^‘ ]+)"+  = Just $ NotInScopeThing name+  | Just [name] <- matchRegexUnifySpaces x "ot in scope:[^‘]*‘([^’]*)’"+  = Just $ NotInScopeThing name+  | otherwise+  = Nothing++extractQualifiedModuleName :: T.Text -> Maybe T.Text+extractQualifiedModuleName x+  | Just [m] <- matchRegexUnifySpaces x "module named [^‘]*‘([^’]*)’"+  = Just m+  | otherwise+  = Nothing++-- | If a module has been imported qualified, and we want to ues the same qualifier for other modules+-- which haven't been imported, 'extractQualifiedModuleName' won't work. Thus we need extract the qualifier+-- from the imported one.+--+-- For example, we write f = T.putStrLn, where putStrLn comes from Data.Text.IO, with the following import(s):+-- 1.+-- import qualified Data.Text as T+--+-- Module ‘Data.Text’ does not export ‘putStrLn’.+--+-- 2.+-- import qualified Data.Text as T+-- import qualified Data.Functor as T+--+-- Neither ‘Data.Functor’ nor ‘Data.Text’ exports ‘putStrLn’.+--+-- 3.+-- import qualified Data.Text as T+-- import qualified Data.Functor as T+-- import qualified Data.Function as T+--+-- Neither ‘Data.Function’,+--         ‘Data.Functor’ nor ‘Data.Text’ exports ‘putStrLn’.+extractDoesNotExportModuleName :: T.Text -> Maybe T.Text+extractDoesNotExportModuleName x+  | Just [m] <-+    matchRegexUnifySpaces x "Module ‘([^’]*)’ does not export"+      <|> matchRegexUnifySpaces x "nor ‘([^’]*)’ exports"+  = Just m+  | otherwise+  = Nothing+-------------------------------------------------------------------------------------------------+++mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit+mkRenameEdit contents range name =+    if maybeIsInfixFunction == Just True+      then TextEdit range ("`" <> name <> "`")+      else TextEdit range name+  where+    maybeIsInfixFunction = do+      curr <- textInRange range <$> contents+      pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr+++-- | Extract the type and surround it in parentheses except in obviously safe cases.+--+-- Inferring when parentheses are actually needed around the type signature would+-- require understanding both the precedence of the context of the hole and of+-- the signature itself. Inserting them (almost) unconditionally is ugly but safe.+extractWildCardTypeSignature :: T.Text -> T.Text+extractWildCardTypeSignature msg+  | enclosed || not isApp || isToplevelSig = sig+  | otherwise                              = "(" <> sig <> ")"+  where+    msgSigPart      = snd $ T.breakOnEnd "standing for " msg+    (sig, rest)     = T.span (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') $ msgSigPart+    -- If we're completing something like ‘foo :: _’ parens can be safely omitted.+    isToplevelSig   = errorMessageRefersToToplevelHole rest+    -- Parenthesize type applications, e.g. (Maybe Char).+    isApp           = T.any isSpace sig+    -- Do not add extra parentheses to lists, tuples and already parenthesized types.+    enclosed        = not (T.null sig) && (T.head sig, T.last sig) `elem` [('(', ')'), ('[', ']')]++-- | Detect whether user wrote something like @foo :: _@ or @foo :: (_, Int)@.+-- The former is considered toplevel case for which the function returns 'True',+-- the latter is not toplevel and the returned value is 'False'.+--+-- When type hole is at toplevel then there’s a line starting with+-- "• In the type signature" which ends with " :: _" like in the+-- following snippet:+--+-- source/library/Language/Haskell/Brittany/Internal.hs:131:13: error:+--     • Found type wildcard ‘_’ standing for ‘HsDecl GhcPs’+--       To use the inferred type, enable PartialTypeSignatures+--     • In the type signature: decl :: _+--       In an equation for ‘splitAnnots’:+--           splitAnnots m@HsModule {hsmodAnn, hsmodDecls}+--             = undefined+--             where+--                 ann :: SrcSpanAnnA+--                 decl :: _+--                 L ann decl = head hsmodDecls+--     • Relevant bindings include+--       [REDACTED]+--+-- When type hole is not at toplevel there’s a stack of where+-- the hole was located ending with "In the type signature":+--+-- source/library/Language/Haskell/Brittany/Internal.hs:130:20: error:+--     • Found type wildcard ‘_’ standing for ‘GhcPs’+--       To use the inferred type, enable PartialTypeSignatures+--     • In the first argument of ‘HsDecl’, namely ‘_’+--       In the type ‘HsDecl _’+--       In the type signature: decl :: HsDecl _+--     • Relevant bindings include+--       [REDACTED]+errorMessageRefersToToplevelHole :: T.Text -> Bool+errorMessageRefersToToplevelHole msg =+  not (T.null prefix) && " :: _" `T.isSuffixOf` T.takeWhile (/= '\n') rest+  where+    (prefix, rest) = T.breakOn "• In the type signature:" msg++extractRenamableTerms :: T.Text -> [T.Text]+extractRenamableTerms msg+  -- Account for both "Variable not in scope" and "Not in scope"+  | "ot in scope:" `T.isInfixOf` msg = extractSuggestions msg+  | otherwise = []+  where+    extractSuggestions = map getEnclosed+                       . concatMap singleSuggestions+                       . filter isKnownSymbol+                       . T.lines+    singleSuggestions = T.splitOn "), " -- Each suggestion is comma delimited+    isKnownSymbol t = " (imported from" `T.isInfixOf` t || " (line " `T.isInfixOf` t+    getEnclosed = T.dropWhile (== '‘')+                . T.dropWhileEnd (== '’')+                . T.dropAround (\c -> c /= '‘' && c /= '’')++-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace+-- between the end of the range and the next newline), extend the range to take up the whole line.+extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range+extendToWholeLineIfPossible contents range@Range{..} =+    let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . splitTextAtPosition _end) contents+        extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line+    in if extend then Range _start (Position (_line _end + 1) 0) else range++splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)+splitTextAtPosition (Position (fromIntegral -> row) (fromIntegral -> col)) x+    | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x+    , (preCol, postCol) <- T.splitAt col mid+        = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)+    | otherwise = (x, T.empty)++-- | Returns [start .. end[+textInRange :: Range -> T.Text -> T.Text+textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCol)) (Position (fromIntegral -> endRow) (fromIntegral -> endCol))) text =+    case compare startRow endRow of+      LT ->+        let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine+            (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of+              [] -> ("", [])+              firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween)+            maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines+        in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine)+      EQ ->+        let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine)+        in T.take (endCol - startCol) (T.drop startCol line)+      GT -> ""+    where+      linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)++-- | Returns the ranges for a binding in an import declaration+rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]+rangesForBindingImport ImportDecl{ideclHiding = Just (False, L _ lies)} b =+    concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies+  where+    b' = wrapOperatorInParens b+rangesForBindingImport _ _ = []++wrapOperatorInParens :: String -> String+wrapOperatorInParens x =+  case uncons x of+    -- see #2483 and #2859+    -- common lens functions use the _ prefix, and should not be wrapped in parens+    Just ('_', _t) -> x+    Just (h, _t)   -> if isAlpha h then x else "(" <> x <> ")"+    Nothing        -> mempty++smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]+smallerRangesForBindingExport lies b =+    concatMap (mapMaybe srcSpanToRange . ranges') lies+  where+    unqualify = snd . breakOnEnd "."+    b' = wrapOperatorInParens . unqualify $ b+#if !MIN_VERSION_ghc(9,2,0)+    ranges' (L _ (IEThingWith _ thing _  inners labels))+      | T.unpack (printOutputable thing) == b' = []+      | otherwise =+          [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b']+          ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b']+#else+    ranges' (L _ (IEThingWith _ thing _  inners))+      | T.unpack (printOutputable thing) == b' = []+      | otherwise =+          [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b']+#endif+    ranges' _ = []++rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]+rangesForBinding' b (L (locA -> l) x@IEVar{}) | T.unpack (printOutputable x) == b = [l]+rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | T.unpack (printOutputable x) == b = [l]+rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | T.unpack (printOutputable x) == b = [l]+#if !MIN_VERSION_ghc(9,2,0)+rangesForBinding' b (L l (IEThingWith _ thing _  inners labels))+#else+rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _  inners))+#endif+    | T.unpack (printOutputable thing) == b = [l]+    | otherwise =+        [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b]+#if !MIN_VERSION_ghc(9,2,0)+        ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b]+#endif+rangesForBinding' _ _ = []++-- | 'matchRegex' combined with 'unifySpaces'+matchRegexUnifySpaces :: T.Text -> T.Text -> Maybe [T.Text]+matchRegexUnifySpaces message = matchRegex (unifySpaces message)++-- | 'allMatchRegex' combined with 'unifySpaces'+allMatchRegexUnifySpaces :: T.Text -> T.Text -> Maybe [[T.Text]]+allMatchRegexUnifySpaces message =+    allMatchRegex (unifySpaces message)++-- | Returns Just (the submatches) for the first capture, or Nothing.+matchRegex :: T.Text -> T.Text -> Maybe [T.Text]+matchRegex message regex = case message =~~ regex of+    Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings+    Nothing                                                -> Nothing++-- | Returns Just (all matches) for the first capture, or Nothing.+allMatchRegex :: T.Text -> T.Text -> Maybe [[T.Text]]+allMatchRegex message regex = message =~~ regex+++unifySpaces :: T.Text -> T.Text+unifySpaces    = T.unwords . T.words++-- functions to help parse multiple import suggestions++-- | Returns the first match if found+regexSingleMatch :: T.Text -> T.Text -> Maybe T.Text+regexSingleMatch msg regex = case matchRegexUnifySpaces msg regex of+    Just (h:_) -> Just h+    _          -> Nothing++-- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and+-- | return (Data.Map, app/ModuleB.hs:2:1-18)+regExPair :: (T.Text, T.Text) -> Maybe (T.Text, T.Text)+regExPair (modname, srcpair) = do+  x <- regexSingleMatch modname "‘([^’]*)’"+  y <- regexSingleMatch srcpair "\\((.*)\\)"+  return (x, y)++-- | Process a list of (module_name, filename:src_span) values+-- | Eg. [(Data.Map, app/ModuleB.hs:2:1-18), (Data.HashMap.Strict, app/ModuleB.hs:3:1-29)]+regExImports :: T.Text -> Maybe [(T.Text, T.Text)]+regExImports msg = result+  where+    parts = T.words msg+    isPrefix = not . T.isPrefixOf "("+    (mod, srcspan) = partition isPrefix  parts+    -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18))+    result = if length mod == length srcspan then+               regExPair `traverse` zip mod srcspan+             else Nothing++matchRegExMultipleImports :: T.Text -> Maybe (T.Text, [(T.Text, T.Text)])+matchRegExMultipleImports message = do+  let pat = T.pack "Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$"+  (binding, imports) <- case matchRegexUnifySpaces message pat of+                            Just [x, xs] -> Just (x, xs)+                            _            -> Nothing+  imps <- regExImports imports+  return (binding, imps)++-- | Possible import styles for an 'IdentInfo'.+--+-- The first 'Text' parameter corresponds to the 'rendered' field of the+-- 'IdentInfo'.+data ImportStyle+    = ImportTopLevel T.Text+      -- ^ Import a top-level export from a module, e.g., a function, a type, a+      -- class.+      --+      -- > import M (?)+      --+      -- Some exports that have a parent, like a type-class method or an+      -- associated type/data family, can still be imported as a top-level+      -- import.+      --+      -- Note that this is not the case for constructors, they must always be+      -- imported as part of their parent data type.++    | ImportViaParent T.Text T.Text+      -- ^ Import an export (first parameter) through its parent (second+      -- parameter).+      --+      -- import M (P(?))+      --+      -- @P@ and @?@ can be a data type and a constructor, a class and a method,+      -- a class and an associated type/data family, etc.++    | ImportAllConstructors T.Text+      -- ^ Import all constructors for a specific data type.+      --+      -- import M (P(..))+      --+      -- @P@ can be a data type or a class.+  deriving Show++importStyles :: IdentInfo -> NonEmpty ImportStyle+importStyles IdentInfo {parent, rendered, isDatacon}+  | Just p <- parent+    -- Constructors always have to be imported via their parent data type, but+    -- methods and associated type/data families can also be imported as+    -- top-level exports.+  = ImportViaParent rendered p+      :| [ImportTopLevel rendered | not isDatacon]+      <> [ImportAllConstructors p]+  | otherwise+  = ImportTopLevel rendered :| []++-- | Used for adding new imports+renderImportStyle :: ImportStyle -> T.Text+renderImportStyle (ImportTopLevel x)   = x+renderImportStyle (ImportViaParent x p@(T.uncons -> Just ('(', _))) = "type " <> p <> "(" <> x <> ")"+renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")"+renderImportStyle (ImportAllConstructors p) = p <> "(..)"++-- | Used for extending import lists+unImportStyle :: ImportStyle -> (Maybe String, String)+unImportStyle (ImportTopLevel x)        = (Nothing, T.unpack x)+unImportStyle (ImportViaParent x y)     = (Just $ T.unpack y, T.unpack x)+unImportStyle (ImportAllConstructors x) = (Just $ T.unpack x, wildCardSymbol)+++quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind+quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.topLevel"+quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.withParent"+quickFixImportKind' x (ImportAllConstructors _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.allConstructors"++quickFixImportKind :: T.Text -> CodeActionKind+quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x
+ src/Development/IDE/Plugin/CodeAction/Args.hs view
@@ -0,0 +1,300 @@+module Development.IDE.Plugin.CodeAction.Args+  ( CodeActionTitle,+    CodeActionPreferred,+    GhcideCodeActionResult,+    GhcideCodeAction,+    mkGhcideCAPlugin,+    mkGhcideCAsPlugin,+    ToTextEdit (..),+    ToCodeAction (..),+    wrap,+    mkCA,+  )+where++import           Control.Concurrent.STM.Stats                 (readTVarIO)+import           Control.Monad.Reader+import           Control.Monad.Trans.Maybe+import           Data.Either                                  (fromRight)+import qualified Data.HashMap.Strict                          as Map+import           Data.IORef.Extra+import           Data.Maybe                                   (fromMaybe)+import qualified Data.Text                                    as T+import           Development.IDE                              hiding+                                                              (pluginHandlers)+import           Development.IDE.Core.Shake+import           Development.IDE.GHC.Compat+import           Development.IDE.GHC.Compat.ExactPrint+import           Development.IDE.GHC.ExactPrint+#if !MIN_VERSION_ghc(9,3,0)+import           Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite,+                                                               rewriteToEdit)+#endif+import           Development.IDE.Plugin.TypeLenses            (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs),+                                                               GlobalBindingTypeSigsResult)+import           Development.IDE.Spans.LocalBindings          (Bindings)+import           Development.IDE.Types.Exports                (ExportsMap)+import           Development.IDE.Types.Options                (IdeOptions)+import           Ide.Plugin.Config                            (Config)+import           Ide.Types+import qualified Language.LSP.Server                          as LSP+import           Language.LSP.Types++type CodeActionTitle = T.Text++type CodeActionPreferred = Bool++type GhcideCodeActionResult = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])]++type GhcideCodeAction = ReaderT CodeActionArgs IO GhcideCodeActionResult++-------------------------------------------------------------------------------------------------++{-# ANN runGhcideCodeAction ("HLint: ignore Move guards forward" :: String) #-}+runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams TextDocumentCodeAction -> GhcideCodeAction -> m GhcideCodeActionResult+runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = List diags}) codeAction = do+  let mbFile = toNormalizedFilePath' <$> uriToFilePath uri+      runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure mbFile) >>= MaybeT . use key+  caaGhcSession <- onceIO $ runRule GhcSession+  caaExportsMap <-+    onceIO $+      caaGhcSession >>= \case+        Just env -> do+          pkgExports <- envPackageExports env+          localExports <- readTVarIO (exportsMap $ shakeExtras state)+          pure $ localExports <> pkgExports+        _ -> pure mempty+  caaIdeOptions <- onceIO $ runAction "GhcideCodeActions.getIdeOptions" state getIdeOptions+  caaParsedModule <- onceIO $ runRule GetParsedModuleWithComments+  caaContents <-+    onceIO $+      runRule GetFileContents >>= \case+        Just (_, txt) -> pure txt+        _             -> pure Nothing+  caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule+#if !MIN_VERSION_ghc(9,3,0)+  caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource+#endif+  caaTmr <- onceIO $ runRule TypeCheck+  caaHar <- onceIO $ runRule GetHieAst+  caaBindings <- onceIO $ runRule GetBindings+  caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs+  liftIO $+    concat+      <$> sequence+        [ runReaderT codeAction caa+          | caaDiagnostic <- diags,+            let caa = CodeActionArgs {..}+        ]++mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction)+mkCA title kind isPreferred diags edit =+  InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing Nothing++mkGhcideCAPlugin :: GhcideCodeAction -> PluginId -> PluginDescriptor IdeState+mkGhcideCAPlugin codeAction plId =+  (defaultPluginDescriptor plId)+    { pluginHandlers = mkPluginHandler STextDocumentCodeAction $+        \state _ params@(CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext {_diagnostics = List diags}) -> do+          results <- runGhcideCodeAction state params codeAction+          pure $+            Right $+              List+                [ mkCA title kind isPreferred diags edit+                  | (title, kind, isPreferred, tedit) <- results,+                    let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing+                ]+    }++mkGhcideCAsPlugin :: [GhcideCodeAction] -> PluginId -> PluginDescriptor IdeState+mkGhcideCAsPlugin codeActions = mkGhcideCAPlugin $ mconcat codeActions++-------------------------------------------------------------------------------------------------++class ToTextEdit a where+  toTextEdit :: CodeActionArgs -> a -> IO [TextEdit]++instance ToTextEdit TextEdit where+  toTextEdit _ = pure . pure++#if !MIN_VERSION_ghc(9,3,0)+instance ToTextEdit Rewrite where+  toTextEdit CodeActionArgs {..} rw = fmap (fromMaybe []) $+    runMaybeT $ do+      df <- MaybeT caaDf+#if !MIN_VERSION_ghc(9,2,0)+      ps <- MaybeT caaAnnSource+      let r = rewriteToEdit df (annsA ps) rw+#else+      let r = rewriteToEdit df rw+#endif+      pure $ fromRight [] r+#endif++instance ToTextEdit a => ToTextEdit [a] where+  toTextEdit caa = foldMap (toTextEdit caa)++instance ToTextEdit a => ToTextEdit (Maybe a) where+  toTextEdit caa = maybe (pure []) (toTextEdit caa)++instance (ToTextEdit a, ToTextEdit b) => ToTextEdit (Either a b) where+  toTextEdit caa = either (toTextEdit caa) (toTextEdit caa)++-------------------------------------------------------------------------------------------------++data CodeActionArgs = CodeActionArgs+  { caaExportsMap   :: IO ExportsMap,+    caaGhcSession   :: IO (Maybe HscEnvEq),+    caaIdeOptions   :: IO IdeOptions,+    caaParsedModule :: IO (Maybe ParsedModule),+    caaContents     :: IO (Maybe T.Text),+    caaDf           :: IO (Maybe DynFlags),+#if MIN_VERSION_ghc(9,3,0)+    caaAnnSource    :: IO (Maybe ParsedSource),+#else+    caaAnnSource    :: IO (Maybe (Annotated ParsedSource)),+#endif+    caaTmr          :: IO (Maybe TcModuleResult),+    caaHar          :: IO (Maybe HieAstResult),+    caaBindings     :: IO (Maybe Bindings),+    caaGblSigs      :: IO (Maybe GlobalBindingTypeSigsResult),+    caaDiagnostic   :: Diagnostic+  }++-- | There's no concurrency in each provider,+-- so we don't need to be thread-safe here+onceIO :: MonadIO m => IO a -> m (IO a)+onceIO io = do+  var <- liftIO $ newIORef Nothing+  pure $+    readIORef var >>= \case+      Just x -> pure x+      _      -> io >>= \x -> writeIORef' var (Just x) >> pure x++-------------------------------------------------------------------------------------------------++wrap :: (ToCodeAction a) => a -> GhcideCodeAction+wrap = toCodeAction++class ToCodeAction a where+  toCodeAction :: a -> GhcideCodeAction++instance ToCodeAction GhcideCodeAction where+  toCodeAction = id++instance Semigroup GhcideCodeAction where+  a <> b = toCodeAction [a, b]++instance Monoid GhcideCodeAction where+  mempty = pure []++instance ToCodeAction a => ToCodeAction [a] where+  toCodeAction = fmap concat . mapM toCodeAction++instance ToCodeAction a => ToCodeAction (Maybe a) where+  toCodeAction = maybe (pure []) toCodeAction++instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where+  toCodeAction (title, te) = ReaderT $ \caa -> pure . (title,Just CodeActionQuickFix,Nothing,) <$> toTextEdit caa te++instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where+  toCodeAction (title, kind, te) = ReaderT $ \caa -> pure . (title,Just kind,Nothing,) <$> toTextEdit caa te++instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where+  toCodeAction (title, isPreferred, te) = ReaderT $ \caa -> pure . (title,Just CodeActionQuickFix,Just isPreferred,) <$> toTextEdit caa te++instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where+  toCodeAction (title, kind, isPreferred, te) = ReaderT $ \caa -> pure . (title,Just kind,Just isPreferred,) <$> toTextEdit caa te++-------------------------------------------------------------------------------------------------++toCodeAction1 :: (ToCodeAction r) => (CodeActionArgs -> IO (Maybe a)) -> (Maybe a -> r) -> GhcideCodeAction+toCodeAction1 get f = ReaderT $ \caa -> get caa >>= flip runReaderT caa . toCodeAction . f++toCodeAction2 :: (ToCodeAction r) => (CodeActionArgs -> IO (Maybe a)) -> (a -> r) -> GhcideCodeAction+toCodeAction2 get f = ReaderT $ \caa ->+  get caa >>= \case+    Just x -> flip runReaderT caa . toCodeAction . f $ x+    _      -> pure []++toCodeAction3 :: (ToCodeAction r) => (CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction+toCodeAction3 get f = ReaderT $ \caa -> get caa >>= flip runReaderT caa . toCodeAction . f++-- | this instance returns a delta AST, useful for exactprint transforms+instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where+#if !MIN_VERSION_ghc(9,3,0)+  toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} ->+    x >>= \case+      Just s -> flip runReaderT caa . toCodeAction . f . astA $ s+      _      -> pure []+#else+  toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} ->+    x >>= \case+      Just s -> flip runReaderT caa . toCodeAction . f . pm_parsed_source $ s+      _      -> pure []+#endif++instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where+  toCodeAction = toCodeAction3 caaExportsMap++instance ToCodeAction r => ToCodeAction (IdeOptions -> r) where+  toCodeAction = toCodeAction3 caaIdeOptions++instance ToCodeAction r => ToCodeAction (Diagnostic -> r) where+  toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaDiagnostic = x} -> flip runReaderT caa . toCodeAction $ f x++instance ToCodeAction r => ToCodeAction (Maybe ParsedModule -> r) where+  toCodeAction = toCodeAction1 caaParsedModule++instance ToCodeAction r => ToCodeAction (ParsedModule -> r) where+  toCodeAction = toCodeAction2 caaParsedModule++instance ToCodeAction r => ToCodeAction (Maybe T.Text -> r) where+  toCodeAction = toCodeAction1 caaContents++instance ToCodeAction r => ToCodeAction (T.Text -> r) where+  toCodeAction = toCodeAction2 caaContents++instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where+  toCodeAction = toCodeAction1 caaDf++instance ToCodeAction r => ToCodeAction (DynFlags -> r) where+  toCodeAction = toCodeAction2 caaDf++#if !MIN_VERSION_ghc(9,3,0)+instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where+  toCodeAction = toCodeAction1 caaAnnSource++instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where+  toCodeAction = toCodeAction2 caaAnnSource+#endif++instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where+  toCodeAction = toCodeAction1 caaTmr++instance ToCodeAction r => ToCodeAction (TcModuleResult -> r) where+  toCodeAction = toCodeAction2 caaTmr++instance ToCodeAction r => ToCodeAction (Maybe HieAstResult -> r) where+  toCodeAction = toCodeAction1 caaHar++instance ToCodeAction r => ToCodeAction (HieAstResult -> r) where+  toCodeAction = toCodeAction2 caaHar++instance ToCodeAction r => ToCodeAction (Maybe Bindings -> r) where+  toCodeAction = toCodeAction1 caaBindings++instance ToCodeAction r => ToCodeAction (Bindings -> r) where+  toCodeAction = toCodeAction2 caaBindings++instance ToCodeAction r => ToCodeAction (Maybe GlobalBindingTypeSigsResult -> r) where+  toCodeAction = toCodeAction1 caaGblSigs++instance ToCodeAction r => ToCodeAction (GlobalBindingTypeSigsResult -> r) where+  toCodeAction = toCodeAction2 caaGblSigs++instance ToCodeAction r => ToCodeAction (Maybe HscEnvEq -> r) where+  toCodeAction = toCodeAction1 caaGhcSession++instance ToCodeAction r => ToCodeAction (Maybe HscEnv -> r) where+  toCodeAction = toCodeAction1 ((fmap.fmap.fmap) hscEnv caaGhcSession)
+ src/Development/IDE/Plugin/CodeAction/ExactPrint.hs view
@@ -0,0 +1,725 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs        #-}+module Development.IDE.Plugin.CodeAction.ExactPrint (+  Rewrite (..),+  rewriteToEdit,+  rewriteToWEdit,+#if !MIN_VERSION_ghc(9,2,0)+  transferAnn,+#endif++  -- * Utilities+  appendConstraint,+  removeConstraint,+  extendImport,+  hideSymbol,+  liftParseAST,++  wildCardSymbol+) where++import           Control.Monad+import           Control.Monad.Trans+import           Data.Char                       (isAlphaNum)+import           Data.Data                       (Data)+import           Data.Generics                   (listify)+import qualified Data.Text                       as T+import           Development.IDE.GHC.Compat      hiding (Annotation)+import           Development.IDE.GHC.Error+import           Development.IDE.GHC.ExactPrint+import           Development.IDE.GHC.Util+import           Development.IDE.Spans.Common+import           GHC.Exts                        (IsList (fromList))+import           GHC.Stack                       (HasCallStack)+import           Language.Haskell.GHC.ExactPrint+import           Language.LSP.Types++import           Development.IDE.Plugin.CodeAction.Util++-- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports.+#if MIN_VERSION_ghc(9,2,0)+import           Control.Lens   (_head, _last, over)+import           Data.Bifunctor (first)+import           Data.Default   (Default (..))+import           Data.Maybe     (fromJust, fromMaybe, mapMaybe)+import           GHC            (AddEpAnn (..), AnnContext (..), AnnList (..),+                                 AnnParen (..), DeltaPos (SameLine), EpAnn (..),+                                 EpaLocation (EpaDelta),+                                 IsUnicodeSyntax (NormalSyntax),+                                 NameAdornment (NameParens),+                                 TrailingAnn (AddCommaAnn), addAnns, ann,+                                 emptyComments, reAnnL)+#else+import           Control.Applicative                   (Alternative ((<|>)))+import           Control.Monad.Extra                   (whenJust)+import           Data.Foldable                         (find)+import           Data.Functor                          (($>))+import qualified Data.Map.Strict                       as Map+import           Data.Maybe                            (fromJust, isJust,+                                                        isNothing, mapMaybe)+import qualified Development.IDE.GHC.Compat.Util       as Util+import           Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),+                                                        KeywordId (G), mkAnnKey)+#endif++------------------------------------------------------------------------------++-- | Construct a 'Rewrite', replacing the node at the given 'SrcSpan' with the+--   given 'ast'.+data Rewrite where+  Rewrite ::+#if !MIN_VERSION_ghc(9,2,0)+    Annotate ast =>+#else+    (ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast), Outputable (GenLocated (Anno ast) ast), Data (GenLocated (Anno ast) ast)) =>+#endif+    -- | The 'SrcSpan' that we want to rewrite+    SrcSpan ->+    -- | The ast that we want to graft+#if !MIN_VERSION_ghc(9,2,0)+    (DynFlags -> TransformT (Either String) (Located ast)) ->+#else+    (DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)) ->+#endif+    Rewrite++------------------------------------------------------------------------------+#if MIN_VERSION_ghc(9,2,0)+class ResetEntryDP ann where+    resetEntryDP :: GenLocated ann ast -> GenLocated ann ast+instance {-# OVERLAPPING #-} Default an => ResetEntryDP (SrcAnn an) where+    -- resetEntryDP = flip setEntryDP (SameLine 0)+    resetEntryDP (L srcAnn x) = setEntryDP (L srcAnn{ann=EpAnnNotUsed} x) (SameLine 0)+instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where+    resetEntryDP = id+#endif++-- | Convert a 'Rewrite' into a list of '[TextEdit]'.+rewriteToEdit :: HasCallStack =>+  DynFlags ->+#if !MIN_VERSION_ghc(9,2,0)+  Anns ->+#endif+  Rewrite ->+  Either String [TextEdit]+rewriteToEdit dflags+#if !MIN_VERSION_ghc(9,2,0)+              anns+#endif+              (Rewrite dst f) = do+  (ast, anns , _) <- runTransformT+#if !MIN_VERSION_ghc(9,2,0)+                            anns+#endif+                          $ do+    ast <- f dflags+#if !MIN_VERSION_ghc(9,2,0)+    ast <$ setEntryDPT ast (DP (0, 0))+#else+    pure $ traceAst "REWRITE_result" $ resetEntryDP ast+#endif+  let editMap =+        [ TextEdit (fromJust $ srcSpanToRange dst) $+            T.pack $ exactPrint ast+#if !MIN_VERSION_ghc(9,2,0)+                       (fst anns)+#endif+        ]+  pure editMap++-- | Convert a 'Rewrite' into a 'WorkspaceEdit'+rewriteToWEdit :: DynFlags+               -> Uri+#if !MIN_VERSION_ghc(9,2,0)+               -> Anns+#endif+               -> Rewrite+               -> Either String WorkspaceEdit+rewriteToWEdit dflags uri+#if !MIN_VERSION_ghc(9,2,0)+               anns+#endif+               r = do+  edits <- rewriteToEdit dflags+#if !MIN_VERSION_ghc(9,2,0)+                         anns+#endif+                         r+  return $+    WorkspaceEdit+      { _changes = Just (fromList [(uri, List edits)])+      , _documentChanges = Nothing+      , _changeAnnotations = Nothing+      }++------------------------------------------------------------------------------++#if !MIN_VERSION_ghc(9,2,0)+-- | Fix the parentheses around a type context+fixParens ::+  (Monad m, Data (HsType pass), pass ~ GhcPass p0) =>+  Maybe DeltaPos ->+  Maybe DeltaPos ->+  LHsContext pass ->+  TransformT m [LHsType pass]+fixParens+          openDP closeDP+          ctxt@(L _ elems) = do+  -- Paren annotation for type contexts are usually quite screwed up+  -- we remove duplicates and fix negative DPs+  let parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)]+  modifyAnnsT $+    Map.adjust+      ( \x ->+          let annsMap = Map.fromList (annsDP x)+           in x+                { annsDP =+                    Map.toList $+                      Map.alter (\_ -> openDP <|> Just dp00) (G AnnOpenP) $+                        Map.alter (\_ -> closeDP <|> Just dp00) (G AnnCloseP) $+                          annsMap <> parens+                }+      )+      (mkAnnKey ctxt)+  return $ map dropHsParTy elems+#endif++dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass)+dropHsParTy (L _ (HsParTy _ ty)) = ty+dropHsParTy other                = other++removeConstraint ::+  -- | Predicate: Which context to drop.+  (LHsType GhcPs -> Bool) ->+  LHsType GhcPs ->+  Rewrite+removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input"+  where+    go :: LHsType GhcPs -> Rewrite+#if !MIN_VERSION_ghc(9,2,0)+    go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do+#else+    go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do+#endif+      let ctxt' = filter (not . toRemove) ctxt+          removeStuff = (toRemove <$> headMaybe ctxt) == Just True+#if !MIN_VERSION_ghc(9,2,0)+      when removeStuff  $+        setEntryDPT hst_body (DP (0, 0))+      return $ L l $ it{hst_ctxt =  L l' ctxt'}+#else+      let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body+      return $ case ctxt' of+          [] -> hst_body'+          _ -> do+            let ctxt'' = over _last (first removeComma) ctxt'+            L l $ it{ hst_ctxt = Just $ L l' ctxt''+                    , hst_body = hst_body'+                    }+#endif+    go (L _ (HsParTy _ ty)) = go ty+    go (L _ HsForAllTy{hst_body}) = go hst_body+    go (L l other) = Rewrite (locA l) $ \_ -> return $ L l other++-- | Append a constraint at the end of a type context.+--   If no context is present, a new one will be created.+appendConstraint ::+  -- | The new constraint to append+  String ->+  -- | The type signature where the constraint is to be inserted, also assuming annotated+  LHsType GhcPs ->+  Rewrite+appendConstraint constraintT = go . traceAst "appendConstraint"+ where+#if !MIN_VERSION_ghc(9,2,0)+  go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do+#else+  go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do+#endif+    constraint <- liftParseAST df constraintT+#if !MIN_VERSION_ghc(9,2,0)+    setEntryDPT constraint (DP (0, 1))++    -- Paren annotations are usually attached to the first and last constraints,+    -- rather than to the constraint list itself, so to preserve them we need to reposition them+    closeParenDP <- lookupAnn (G AnnCloseP) `mapM` lastMaybe ctxt+    openParenDP <- lookupAnn (G AnnOpenP) `mapM` headMaybe ctxt+    ctxt' <- fixParens+                (join openParenDP) (join closeParenDP)+                (L l' ctxt)+    addTrailingCommaT (last ctxt')+    return $ L l $ it{hst_ctxt = L l' $ ctxt' ++ [constraint]}+#else+    constraint <- pure $ setEntryDP constraint (SameLine 1)+    let l'' = (fmap.fmap) (addParensToCtxt close_dp) l'+    -- For singleton constraints, the close Paren DP is attached to an HsPar wrapping the constraint+    -- we have to reposition it manually into the AnnContext+        close_dp = case ctxt of+            [L _ (HsParTy EpAnn{anns=AnnParen{ap_close}} _)] -> Just ap_close+            _ -> Nothing+        ctxt' = over _last (first addComma) $ map dropHsParTy ctxt+    return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]}+#endif+  go (L _ HsForAllTy{hst_body}) = go hst_body+  go (L _ (HsParTy _ ty)) = go ty+  go ast@(L l _) = Rewrite (locA l) $ \df -> do+    -- there isn't a context, so we must create one+    constraint <- liftParseAST df constraintT+    lContext <- uniqueSrcSpanT+    lTop <- uniqueSrcSpanT+#if !MIN_VERSION_ghc(9,2,0)+    let context = L lContext [constraint]+    addSimpleAnnT context dp00 $+      (G AnnDarrow, DP (0, 1)) :+      concat+        [ [ (G AnnOpenP, dp00)+          , (G AnnCloseP, dp00)+          ]+        | hsTypeNeedsParens sigPrec $ unLoc constraint+        ]+#else+    let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint]+        annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens]+        needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint+    ast <- pure $ setEntryDP ast (SameLine 1)+#endif++    return $ reLocA $ L lTop $ HsQualTy noExtField context ast++liftParseAST+    :: forall ast l.  (ASTElement l ast, ExactPrint (LocatedAn l ast))+    => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)+liftParseAST df s = case parseAST df "" s of+#if !MIN_VERSION_ghc(9,2,0)+  Right (anns, x) -> modifyAnnsT (anns <>) $> x+#else+  Right x ->  pure (makeDeltaAst x)+#endif+  Left _          -> lift $ Left $ "No parse: " <> s++#if !MIN_VERSION_ghc(9,2,0)+lookupAnn :: (Data a, Monad m)+          => KeywordId -> Located a -> TransformT m (Maybe DeltaPos)+lookupAnn comment la = do+  anns <- getAnnsT+  return $ Map.lookup (mkAnnKey la) anns >>= lookup comment . annsDP++dp00 :: DeltaPos+dp00 = DP (0, 0)++-- | Copy anns attached to a into b with modification, then delete anns of a+transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) ()+transferAnn la lb f = do+  anns <- getAnnsT+  let oldKey = mkAnnKey la+      newKey = mkAnnKey lb+  oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns+  putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns++#endif++headMaybe :: [a] -> Maybe a+headMaybe []      = Nothing+headMaybe (a : _) = Just a++lastMaybe :: [a] -> Maybe a+lastMaybe []    = Nothing+lastMaybe other = Just $ last other++liftMaybe :: String -> Maybe a -> TransformT (Either String) a+liftMaybe _ (Just x) = return x+liftMaybe s _        = lift $ Left s++------------------------------------------------------------------------------+extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite+extendImport mparent identifier lDecl@(L l _) =+  Rewrite (locA l) $ \df -> do+    case mparent of+      -- This will also work for `ImportAllConstructors`+      Just parent -> extendImportViaParent df parent identifier lDecl+      _           -> extendImportTopLevel identifier lDecl++-- | Add an identifier or a data type to import list. Expects a Delta AST+--+-- extendImportTopLevel "foo" AST:+--+-- import A --> Error+-- import A (foo) --> Error+-- import A (bar) --> import A (bar, foo)+extendImportTopLevel ::+  -- | rendered+  String ->+  LImportDecl GhcPs ->+  TransformT (Either String) (LImportDecl GhcPs)+extendImportTopLevel thing (L l it@ImportDecl{..})+  | Just (hide, L l' lies) <- ideclHiding+    , hasSibling <- not $ null lies = do+    src <- uniqueSrcSpanT+    top <- uniqueSrcSpanT+    let rdr = reLocA $ L src $ mkRdrUnqual $ mkVarOcc thing+    let alreadyImported =+          printOutputable (occName (unLoc rdr))+            `elem` map (printOutputable @OccName) (listify (const True) lies)+    when alreadyImported $+      lift (Left $ thing <> " already imported")++    let lie = reLocA $ L src $ IEName rdr+        x = reLocA $ L top $ IEVar noExtField lie++    if x `elem` lies+      then lift (Left $ thing <> " already imported")+      else do+#if !MIN_VERSION_ghc(9,2,0)+        anns <- getAnnsT+        maybe (pure ()) addTrailingCommaT (lastMaybe lies)+        addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []+        addSimpleAnnT rdr dp00 [(G AnnVal, dp00)]++        -- When the last item already has a trailing comma, we append a trailing comma to the new item.+        let isAnnComma (G AnnComma, _) = True+            isAnnComma _               = False+            shouldAddTrailingComma = maybe False nodeHasComma (lastMaybe lies)+                && not (nodeHasComma (L l' lies))++            nodeHasComma :: Data a => Located a -> Bool+            nodeHasComma x = isJust $ Map.lookup (mkAnnKey x) anns >>= find isAnnComma . annsDP+        when shouldAddTrailingComma (addTrailingCommaT x)++        -- Parens are attachted to `lies`, so if `lies` was empty previously,+        -- we need change the ann key from `[]` to `:` to keep parens and other anns.+        unless hasSibling $+          transferAnn (L l' lies) (L l' [x]) id+        return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])}+#else+        let lies' = addCommaInImportList lies x+        return $ L l it{ideclHiding = Just (hide, L l' lies')}+#endif+extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"++wildCardSymbol :: String+wildCardSymbol = ".."++-- | Add an identifier with its parent to import list+--+-- extendImportViaParent "Bar" "Cons" AST:+--+-- import A --> Error+-- import A (Bar(..)) --> Error+-- import A (Bar(Cons)) --> Error+-- import A () --> import A (Bar(Cons))+-- import A (Foo, Bar) --> import A (Foo, Bar(Cons))+-- import A (Foo, Bar()) --> import A (Foo, Bar(Cons))+--+-- extendImportViaParent "Bar" ".." AST:+-- import A () --> import A (Bar(..))+-- import A (Foo, Bar) -> import A (Foo, Bar(..))+-- import A (Foo, Bar()) -> import A (Foo, Bar(..))+extendImportViaParent ::+  DynFlags ->+  -- | parent (already parenthesized if needs)+  String ->+  -- | rendered child+  String ->+  LImportDecl GhcPs ->+  TransformT (Either String) (LImportDecl GhcPs)+extendImportViaParent df parent child (L l it@ImportDecl{..})+  | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies+ where+  go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie))) : _xs)+    | parent == unIEWrappedName ie = lift . Left $ child <> " already included in " <> parent <> " imports"+  go hide l' pre (lAbs@(L ll' (IEThingAbs _ absIE@(L _ ie))) : xs)+    -- ThingAbs ie => ThingWith ie child+    | parent == unIEWrappedName ie = do+      srcChild <- uniqueSrcSpanT+      let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child+          childLIE = reLocA $ L srcChild $ IEName childRdr+#if !MIN_VERSION_ghc(9,2,0)+          x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] []+      -- take anns from ThingAbs, and attatch parens to it+      transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]}+      addSimpleAnnT childRdr dp00 [(G AnnVal, dp00)]+#else+          x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE]+#endif+      return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)}+#if !MIN_VERSION_ghc(9,2,0)+  go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs)+#else+  go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs)+#endif+    -- ThingWith ie lies' => ThingWith ie (lies' ++ [child])+    | parent == unIEWrappedName ie+    , child == wildCardSymbol = do+#if MIN_VERSION_ghc(9,2,0)+        let it' = it{ideclHiding = Just (hide, lies)}+            thing = IEThingWith newl twIE (IEWildcard 2) []+            newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l'''+            lies = L l' $ reverse pre ++ [L l'' thing] ++ xs+        return $ L l it'+#else+        let thing = L l'' (IEThingWith noExtField twIE (IEWildcard 2)  [] [])+        modifyAnnsT (Map.map (\ann -> ann{annsDP = (G AnnDotdot, dp00) : annsDP ann}))+        return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [thing] ++ xs)}+#endif+    | parent == unIEWrappedName ie+    , hasSibling <- not $ null lies' =+      do+        srcChild <- uniqueSrcSpanT+        let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child+#if MIN_VERSION_ghc(9,2,0)+        childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0+#endif+        let alreadyImported =+              printOutputable (occName (unLoc childRdr))+                `elem` map (printOutputable @OccName) (listify (const True) lies')+        when alreadyImported $+          lift (Left $ child <> " already included in " <> parent <> " imports")++        let childLIE = reLocA $ L srcChild $ IEName childRdr+#if !MIN_VERSION_ghc(9,2,0)+        when hasSibling $+          addTrailingCommaT (last lies')+        addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)]+        return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)}+#else+        let it' = it{ideclHiding = Just (hide, lies)}+            lies = L l' $ reverse pre +++                [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs+            fixLast = if hasSibling then first addComma else id+        return $ L l it'+#endif+  go hide l' pre (x : xs) = go hide l' (x : pre) xs+  go hide l' pre []+    | hasSibling <- not $ null pre = do+      -- [] => ThingWith parent [child]+      l'' <- uniqueSrcSpanT+      srcParent <- uniqueSrcSpanT+      srcChild <- uniqueSrcSpanT+      parentRdr <- liftParseAST df parent+      let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child+          isParentOperator = hasParen parent+#if !MIN_VERSION_ghc(9,2,0)+      when hasSibling $+        addTrailingCommaT (head pre)+      let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr)+          childLIE = reLocA $ L srcChild $ IEName childRdr+#else+      let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName parentRdr')+          parentRdr' = modifyAnns parentRdr $ \case+              it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1}+              other -> other+          childLIE = reLocA $ L srcChild $ IEName childRdr+#endif+#if !MIN_VERSION_ghc(9,2,0)+          x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] []+      -- Add AnnType for the parent if it's parenthesized (type operator)+      when isParentOperator $+        addSimpleAnnT parentLIE (DP (0, 0)) [(G AnnType, DP (0, 0))]+      addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP 1 isParentOperator+      addSimpleAnnT childRdr (DP (0, 0)) [(G AnnVal, dp00)]+      addSimpleAnnT x (DP (0, 0)) [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, DP (0, 0))]+      -- Parens are attachted to `pre`, so if `pre` was empty previously,+      -- we need change the ann key from `[]` to `:` to keep parens and other anns.+      unless hasSibling $+        transferAnn (L l' $ reverse pre) (L l' [x]) id++      let lies' = reverse pre ++ [x]+#else+          listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]+          x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE]++          lies' = addCommaInImportList (reverse pre) x+#endif+      return $ L l it{ideclHiding = Just (hide, L l' lies')}+extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent"++#if MIN_VERSION_ghc(9,2,0)+-- Add an item in an import list, taking care of adding comma if needed.+addCommaInImportList ::+  -- | Initial list+  [LocatedAn AnnListItem a]+  -- | Additionnal item+  -> LocatedAn AnnListItem a+  -> [LocatedAn AnnListItem a]+addCommaInImportList lies x =+    fixLast lies ++ [newItem]+  where+    isTrailingAnnComma :: TrailingAnn -> Bool+    isTrailingAnnComma (AddCommaAnn _) = True+    isTrailingAnnComma _ = False++    -- check if there is an existing trailing comma+    existingTrailingComma = fromMaybe False $ do+        L lastItemSrcAnn _ <- lastMaybe lies+        lastItemAnn <- case ann lastItemSrcAnn of+            EpAnn _ lastItemAnn _ -> pure lastItemAnn+            _ -> Nothing+        pure $ any isTrailingAnnComma (lann_trailing lastItemAnn)++    hasSibling = not . null $ lies++    -- Setup the new item. It should have a preceding whitespace if it has siblings, and a trailing comma if the+    -- preceding item already has one.+    newItem = first (if existingTrailingComma then addComma else id) $+        setEntryDP x (SameLine $ if hasSibling then 1 else 0)++    -- Add the comma (if needed)+    fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a]+    fixLast = over _last (first (if existingTrailingComma then id else addComma))+#endif++unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String+unIEWrappedName (occName -> occ) = T.unpack $ printOutputable $ parenSymOcc occ (ppr occ)++hasParen :: String -> Bool+hasParen ('(' : _) = True+hasParen _         = False++#if !MIN_VERSION_ghc(9,2,0)+unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)]+unqalDP c paren =+  ( if paren+      then \x -> (G AnnOpenP, DP (0, c)) : x : [(G AnnCloseP, dp00)]+      else pure+  )+    (G AnnVal, dp00)+#endif++------------------------------------------------------------------------------++-- | Hide a symbol from import declaration+hideSymbol ::+  String -> LImportDecl GhcPs -> Rewrite+hideSymbol symbol lidecl@(L loc ImportDecl{..}) =+  case ideclHiding of+    Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing+    Just (True, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides)+    Just (False, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports+hideSymbol _ (L _ (XImportDecl _)) =+  error "cannot happen"++extendHiding ::+  String ->+  LImportDecl GhcPs ->+#if !MIN_VERSION_ghc(9,2,0)+  Maybe (Located [LIE GhcPs]) ->+#else+  Maybe (XRec GhcPs [LIE GhcPs]) ->+#endif+  DynFlags ->+  TransformT (Either String) (LImportDecl GhcPs)+extendHiding symbol (L l idecls) mlies df = do+  L l' lies <- case mlies of+#if !MIN_VERSION_ghc(9,2,0)+    Nothing -> flip L [] <$> uniqueSrcSpanT+#else+    Nothing -> do+        src <- uniqueSrcSpanT+        let ann = noAnnSrcSpanDP0 src+            ann' = flip (fmap.fmap) ann $ \x -> x+                {al_rest = [AddEpAnn AnnHiding (epl 1)]+                ,al_open = Just $ AddEpAnn AnnOpenP (epl 1)+                ,al_close = Just $ AddEpAnn AnnCloseP (epl 0)+                }+        return $ L ann' []+#endif+    Just pr -> pure pr+  let hasSibling = not $ null lies+  src <- uniqueSrcSpanT+  top <- uniqueSrcSpanT+  rdr <- liftParseAST df symbol+#if MIN_VERSION_ghc(9,2,0)+  rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr)+#endif+  let lie = reLocA $ L src $ IEName rdr+      x = reLocA $ L top $ IEVar noExtField lie+#if MIN_VERSION_ghc(9,2,0)+  x <- pure $ if hasSibling then first addComma x else x+  lies <- pure $ over _head (`setEntryDP` SameLine 1) lies+#endif+#if !MIN_VERSION_ghc(9,2,0)+      singleHide = L l' [x]+  when (isNothing mlies) $ do+    addSimpleAnnT+      singleHide+      dp00+      [ (G AnnHiding, DP (0, 1))+      , (G AnnOpenP, DP (0, 1))+      , (G AnnCloseP, DP (0, 0))+      ]+  addSimpleAnnT x (DP (0, 0)) []+  addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr+  if hasSibling+    then do+      addTrailingCommaT x+      addSimpleAnnT (head lies) (DP (0, 1)) []+      unless (null $ tail lies) $+        addTrailingCommaT (head lies) -- Why we need this?+    else forM_ mlies $ \lies0 -> do+      transferAnn lies0 singleHide id+#endif+  return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)}+ where+  isOperator = not . all isAlphaNum . occNameString . rdrNameOcc++deleteFromImport ::+  String ->+  LImportDecl GhcPs ->+#if !MIN_VERSION_ghc(9,2,0)+  Located [LIE GhcPs] ->+#else+  XRec GhcPs [LIE GhcPs] ->+#endif+  DynFlags ->+  TransformT (Either String) (LImportDecl GhcPs)+deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do+  let edited = L lieLoc deletedLies+      lidecl' =+        L l $+          idecl+            { ideclHiding = Just (False, edited)+            }+#if !MIN_VERSION_ghc(9,2,0)+  -- avoid import A (foo,)+  whenJust (lastMaybe deletedLies) removeTrailingCommaT+  when (not (null lies) && null deletedLies) $ do+    transferAnn llies edited id+    addSimpleAnnT+      edited+      dp00+      [ (G AnnOpenP, DP (0, 1))+      , (G AnnCloseP, DP (0, 0))+      ]+#endif+  pure lidecl'+ where+  deletedLies =+#if MIN_VERSION_ghc(9,2,0)+    over _last removeTrailingComma $+#endif+    mapMaybe killLie lies+  killLie :: LIE GhcPs -> Maybe (LIE GhcPs)+  killLie v@(L _ (IEVar _ (L _ (unqualIEWrapName -> nam))))+    | nam == symbol = Nothing+    | otherwise = Just v+  killLie v@(L _ (IEThingAbs _ (L _ (unqualIEWrapName -> nam))))+    | nam == symbol = Nothing+    | otherwise = Just v+#if !MIN_VERSION_ghc(9,2,0)+  killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons flds))+#else+  killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons))+#endif+    | nam == symbol = Nothing+    | otherwise =+      Just $+        L lieL $+          IEThingWith+            xt+            ty+            wild+            (filter ((/= symbol) . unqualIEWrapName . unLoc) cons)+#if !MIN_VERSION_ghc(9,2,0)+            (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds)+#endif+  killLie v = Just v
+ src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs view
@@ -0,0 +1,141 @@+-- | Position indexed streams of characters+module Development.IDE.Plugin.CodeAction.PositionIndexed+  ( PositionIndexed+  , PositionIndexedString+  , indexedByPosition+  , indexedByPositionStartingFrom+  , extendAllToIncludeCommaIfPossible+  , extendToIncludePreviousNewlineIfPossible+  , mergeRanges+  )+where++import           Data.Char+import           Data.List+import           Language.LSP.Types (Position (Position),+                                     Range (Range, _end, _start))++type PositionIndexed a = [(Position, a)]++type PositionIndexedString = PositionIndexed Char++-- | Add position indexing to a String.+--+--   > indexedByPositionStartingFrom (0,0) "hey\n ho" ≡+--   >   [ ((0,0),'h')+--   >   , ((0,1),'e')+--   >   , ((0,2),'y')+--   >   , ((0,3),'\n')+--   >   , ((1,0),' ')+--   >   , ((1,1),'h')+--   >   , ((1,2),'o')+--   >   ]+indexedByPositionStartingFrom :: Position -> String -> PositionIndexedString+indexedByPositionStartingFrom initialPos = unfoldr f . (initialPos, ) where+  f (_, []) = Nothing+  f (p@(Position l _), '\n' : rest) =+    Just ((p, '\n'), (Position (l + 1) 0, rest))+  f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c + 1), rest))++-- | Add position indexing to a String.+--+--   > indexedByPosition = indexedByPositionStartingFrom (Position 0 0)+indexedByPosition :: String -> PositionIndexedString+indexedByPosition = indexedByPositionStartingFrom (Position 0 0)++-- | Returns a tuple (before, contents, after) if the range is present.+--   The range is present only if both its start and end positions are present+unconsRange+  :: Range+  -> PositionIndexed a+  -> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)+unconsRange Range {..} indexedString+  | (before, rest@(_ : _)) <- span ((/= _start) . fst) indexedString+  , (mid, after@(_ : _)) <- span ((/= _end) . fst) rest+  = Just (before, mid, after)+  | otherwise+  = Nothing++-- | Strips out all the positions included in the range.+--   Returns 'Nothing' if the start or end of the range are not included in the input.+stripRange :: Range -> PositionIndexed a -> Maybe (PositionIndexed a)+stripRange r s = case unconsRange r s of+  Just (b, _, a) -> Just (b ++ a)+  Nothing        -> Nothing++-- | Returns the smallest possible set of disjoint ranges that is equivalent to the input.+--   Assumes input ranges are sorted on the start positions.+mergeRanges :: [Range] -> [Range]+mergeRanges (r : r' : rest)+  |+    -- r' is contained in r+    _end r > _end r'   = mergeRanges (r : rest)+  |+    -- r and r' are overlapping+    _end r > _start r' = mergeRanges (r { _end = _end r' } : rest)++  | otherwise          = r : mergeRanges (r' : rest)+mergeRanges other = other++-- | Returns a sorted list of ranges with extended selections including preceding or trailing commas+--+-- @+--   a, |b|,  c  ===> a|, b|,  c+--   a,  b,  |c| ===> a,  b|,  c|+--   a, |b|, |c| ===> a|, b||, c|+-- @+--+-- If 'acceptNoComma' is enabled, additional ranges are returned+--+-- @+--   |a|       ===> |a|+--   |a|,  |b| ===> |a,|  |b|+-- @+extendAllToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> [Range] -> [Range]+extendAllToIncludeCommaIfPossible acceptNoComma indexedString =+  mergeRanges . go indexedString . sortOn _start+ where+  go _ [] = []+  go input (r : rr)+    | r' : _ <- extendToIncludeCommaIfPossible acceptNoComma input r+    , Just input' <- stripRange r' input+    = r' : go input' rr+    | otherwise+    = go input rr++extendToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> Range -> [Range]+extendToIncludeCommaIfPossible acceptNoComma indexedString range+  | Just (before, _, after) <- unconsRange range indexedString+  , after' <- dropWhile (isSpace . snd) after+  , before' <- dropWhile (isSpace . snd) (reverse before)+  =+    -- a, |b|, c ===> a|, b|, c+    [ range { _start = start' } | (start', ',') : _ <- [before'] ]+    +++    -- a, |b|, c ===> a, |b, |c+    [ range { _end = end' }+    | (_, ',') : rest <- [after']+    , (end', _) : _ <- pure $ dropWhile (isSpace . snd) rest+    ]+    +++    ([range | acceptNoComma])+  | otherwise+  = [range]++extendToIncludePreviousNewlineIfPossible :: PositionIndexedString -> Range -> Range+extendToIncludePreviousNewlineIfPossible indexedString range+  | Just (before, _, _) <- unconsRange range indexedString+  , maybeFirstSpacePos <- lastSpacePos $ reverse before+  = case maybeFirstSpacePos of+      Nothing  -> range+      Just pos -> range { _start = pos }+  | otherwise = range+  where+    lastSpacePos :: PositionIndexedString -> Maybe Position+    lastSpacePos [] = Nothing+    lastSpacePos ((pos, c):xs) =+      if not $ isSpace c+      then Nothing -- didn't find any space+      else case xs of+              (y:ys) | isSpace $ snd y -> lastSpacePos (y:ys)+              _                        -> Just pos
+ src/Development/IDE/Plugin/CodeAction/Util.hs view
@@ -0,0 +1,56 @@+module Development.IDE.Plugin.CodeAction.Util where++#if MIN_VERSION_ghc(9,2,0)+import           GHC.Utils.Outputable+#else+import           Development.IDE.GHC.Util+import           Development.IDE.GHC.Compat.Util+import           Development.IDE.GHC.Compat+#endif+import           Data.Data                         (Data)+import qualified Data.Unique                       as U+import           Debug.Trace+import           Development.IDE.GHC.Compat.ExactPrint as GHC+import           GHC.Stack+import           System.Environment.Blank          (getEnvDefault)+import           System.IO.Unsafe+import           Text.Printf+import           Development.IDE.GHC.Dump          (showAstDataHtml)+import           Data.Time.Clock.POSIX             (POSIXTime, getCurrentTime,+                                                    utcTimeToPOSIXSeconds)+--------------------------------------------------------------------------------+-- Tracing exactprint terms++-- Should in `Development.IDE.GHC.Orphans`,+-- leave it here to prevent cyclic module dependency++{-# NOINLINE timestamp #-}+timestamp :: POSIXTime+timestamp = utcTimeToPOSIXSeconds $ unsafePerformIO getCurrentTime++debugAST :: Bool+debugAST = unsafePerformIO (getEnvDefault "GHCIDE_DEBUG_AST" "0") == "1"++-- | Prints an 'Outputable' value to stderr and to an HTML file for further inspection+traceAst :: (Data a, ExactPrint a, Outputable a, HasCallStack) => String -> a -> a+traceAst lbl x+  | debugAST = trace doTrace x+  | otherwise = x+  where+#if MIN_VERSION_ghc(9,2,0)+    renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True}+#else+    renderDump = showSDocUnsafe . ppr+#endif+    htmlDump = showAstDataHtml x+    doTrace = unsafePerformIO $ do+        u <- U.newUnique+        let htmlDumpFileName = printf "/tmp/hls/%s-%s-%d.html" (show timestamp) lbl (U.hashUnique u)+        writeFile htmlDumpFileName $ renderDump htmlDump+        return $ unlines+            [prettyCallStack callStack ++ ":"+#if MIN_VERSION_ghc(9,2,0)+            , exactPrint x+#endif+            , "file://" ++ htmlDumpFileName]+
+ test/Main.hs view
@@ -0,0 +1,3747 @@+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE ImplicitParams        #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiWayIf            #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE PatternSynonyms       #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE TypeOperators         #-}+{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}++module Main+  ( main+  ) where++import           Control.Applicative.Combinators+import           Control.Lens                             ((^.))+import           Control.Monad+import           Data.Default+import           Data.Foldable+import           Data.List.Extra+import           Data.Maybe+import qualified Data.Text                                as T+import           Data.Tuple.Extra+import           Development.IDE.GHC.Util+import           Development.IDE.Plugin.Completions.Types (extendImportCommandId)+import           Development.IDE.Test+import           Development.IDE.Types.Location+import           Development.Shake                        (getDirectoryFilesIO)+import           Ide.Types+import           Language.LSP.Test+import           Language.LSP.Types                       hiding+                                                          (SemanticTokenAbsolute (length, line),+                                                           SemanticTokenRelative (length),+                                                           SemanticTokensEdit (_start),+                                                           mkRange)+import qualified Language.LSP.Types                       as LSP+import           Language.LSP.Types.Capabilities+import qualified Language.LSP.Types.Lens                  as L+import           System.Directory+import           System.FilePath+import           System.Info.Extra                        (isMac, isWindows)+import qualified System.IO.Extra+import           System.IO.Extra                          hiding (withTempDir)+import           System.Time.Extra+import           Test.Tasty+import           Test.Tasty.ExpectedFailure+import           Test.Tasty.HUnit+import           Text.Regex.TDFA                          ((=~))+++import           Development.IDE.Plugin.CodeAction        (matchRegExMultipleImports)+import           Test.Hls++import qualified Development.IDE.Plugin.CodeAction        as Refactor+import qualified Development.IDE.Plugin.HLS.GhcIde        as GhcIde++main :: IO ()+main = defaultTestRunner tests++refactorPlugin :: [PluginDescriptor IdeState]+refactorPlugin =+      [ Refactor.iePluginDescriptor mempty "ghcide-code-actions-imports-exports"+      , Refactor.typeSigsPluginDescriptor mempty "ghcide-code-actions-type-signatures"+      , Refactor.bindingsPluginDescriptor mempty "ghcide-code-actions-bindings"+      , Refactor.fillHolePluginDescriptor mempty "ghcide-code-actions-fill-holes"+      , Refactor.extendImportPluginDescriptor mempty "ghcide-completions-1"+      ] ++ GhcIde.descriptors mempty++tests :: TestTree+tests =+  testGroup "refactor"+  [ initializeTests+  , codeActionTests+  , codeActionHelperFunctionTests+  , completionTests+  ]++initializeTests = withResource acquire release tests+  where+    tests :: IO (ResponseMessage Initialize) -> TestTree+    tests getInitializeResponse = testGroup "initialize response capabilities"+        [ chk "   code action"             _codeActionProvider  (Just $ InL True)+        , che "   execute command"         _executeCommandProvider [extendImportCommandId]+        ]+      where+        chk :: (Eq a, Show a) => TestName -> (ServerCapabilities -> a) -> a -> TestTree+        chk title getActual expected =+          testCase title $ getInitializeResponse >>= \ir -> expected @=? (getActual . innerCaps) ir++        che :: TestName -> (ServerCapabilities -> Maybe ExecuteCommandOptions) -> [T.Text] -> TestTree+        che title getActual expected = testCase title doTest+          where+              doTest = do+                  ir <- getInitializeResponse+                  let Just ExecuteCommandOptions {_commands = List commands} = getActual $ innerCaps ir+                  zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) expected commands++    acquire :: IO (ResponseMessage Initialize)+    acquire = run initializeResponse+++    release :: ResponseMessage Initialize -> IO ()+    release = const $ pure ()++    innerCaps :: ResponseMessage Initialize -> ServerCapabilities+    innerCaps (ResponseMessage _ _ (Right (InitializeResult c _))) = c+    innerCaps (ResponseMessage _ _ (Left _)) = error "Initialization error"++completionTests :: TestTree+completionTests =+    testGroup "auto import snippets"+      [ completionCommandTest+        "show imports not in list - simple"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad (msum)", "f = joi"]+        (Position 3 6)+        "join"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad (msum, join)", "f = joi"]+      , completionCommandTest+        "show imports not in list - multi-line"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad (\n    msum)", "f = joi"]+        (Position 4 6)+        "join"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad (\n    msum, join)", "f = joi"]+      , completionCommandTest+        "show imports not in list - names with _"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad as M (msum)", "f = M.mapM_"]+        (Position 3 11)+        "mapM_"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad as M (msum, mapM_)", "f = M.mapM_"]+      , completionCommandTest+        "show imports not in list - initial empty list"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad as M ()", "f = M.joi"]+        (Position 3 10)+        "join"+        ["{-# LANGUAGE NoImplicitPrelude #-}",+        "module A where", "import Control.Monad as M (join)", "f = M.joi"]+      , testGroup "qualified imports"+        [ completionCommandTest+            "single"+            ["{-# LANGUAGE NoImplicitPrelude #-}",+            "module A where", "import Control.Monad ()", "f = Control.Monad.joi"]+            (Position 3 22)+            "join"+            ["{-# LANGUAGE NoImplicitPrelude #-}",+            "module A where", "import Control.Monad (join)", "f = Control.Monad.joi"]+        , completionCommandTest+            "as"+            ["{-# LANGUAGE NoImplicitPrelude #-}",+            "module A where", "import Control.Monad as M ()", "f = M.joi"]+            (Position 3 10)+            "join"+            ["{-# LANGUAGE NoImplicitPrelude #-}",+            "module A where", "import Control.Monad as M (join)", "f = M.joi"]+        , completionCommandTest+            "multiple"+            ["{-# LANGUAGE NoImplicitPrelude #-}",+            "module A where", "import Control.Monad as M ()", "import Control.Monad as N ()", "f = N.joi"]+            (Position 4 10)+            "join"+            ["{-# LANGUAGE NoImplicitPrelude #-}",+            "module A where", "import Control.Monad as M ()", "import Control.Monad as N (join)", "f = N.joi"]+        ]+      , testGroup "Data constructor"+        [ completionCommandTest+            "not imported"+            ["module A where", "import Text.Printf ()", "ZeroPad"]+            (Position 2 4)+            "ZeroPad"+            ["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]+        , completionCommandTest+            "parent imported abs"+            ["module A where", "import Text.Printf (FormatAdjustment)", "ZeroPad"]+            (Position 2 4)+            "ZeroPad"+            ["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]+        , completionNoCommandTest+            "parent imported all"+            ["module A where", "import Text.Printf (FormatAdjustment (..))", "ZeroPad"]+            (Position 2 4)+            "ZeroPad"+        , completionNoCommandTest+            "already imported"+            ["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]+            (Position 2 4)+            "ZeroPad"+        , completionNoCommandTest+            "function from Prelude"+            ["module A where", "import Data.Maybe ()", "Nothing"]+            (Position 2 4)+            "Nothing"+        , completionCommandTest+            "type operator parent"+            ["module A where", "import Data.Type.Equality ()", "f = Ref"]+            (Position 2 8)+            "Refl"+            ["module A where", "import Data.Type.Equality (type (:~:) (Refl))", "f = Ref"]+        ]+      , testGroup "Record completion"+        [ completionCommandTest+            "not imported"+            ["module A where", "import Text.Printf ()", "FormatParse"]+            (Position 2 10)+            "FormatParse {"+            ["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]+        , completionCommandTest+            "parent imported"+            ["module A where", "import Text.Printf (FormatParse)", "FormatParse"]+            (Position 2 10)+            "FormatParse {"+            ["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]+        , completionNoCommandTest+            "already imported"+            ["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]+            (Position 2 10)+            "FormatParse {"+        ]+        , testGroup "Package completion"+          [ completionCommandTest+                  "import Data.Sequence"+                  ["module A where", "foo :: Seq"]+                  (Position 1 9)+                  "Seq"+                  ["module A where", "import Data.Sequence (Seq)", "foo :: Seq"]++          , completionCommandTest+                  "qualified import"+                  ["module A where", "foo :: Seq.Seq"]+                  (Position 1 13)+                  "Seq"+                  ["module A where", "import qualified Data.Sequence as Seq", "foo :: Seq.Seq"]+          ]+      ]++completionCommandTest ::+  String ->+  [T.Text] ->+  Position ->+  T.Text ->+  [T.Text] ->+  TestTree+completionCommandTest name src pos wanted expected = testSession name $ do+  docId <- createDoc "A.hs" "haskell" (T.unlines src)+  _ <- waitForDiagnostics+  compls <- skipManyTill anyMessage (getCompletions docId pos)+  let wantedC = find ( \case+            CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x+            _                                     -> False+            ) compls+  case wantedC of+    Nothing ->+      liftIO $ assertFailure $ "Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls]+    Just CompletionItem {..} -> do+      c <- assertJust "Expected a command" _command+      executeCommand c+      if src /= expected+          then do+            void $ skipManyTill anyMessage loggingNotification+            modifiedCode <- skipManyTill anyMessage (getDocumentEdit docId)+            liftIO $ modifiedCode @?= T.unlines expected+          else do+            expectMessages SWorkspaceApplyEdit 1 $ \edit ->+              liftIO $ assertFailure $ "Expected no edit but got: " <> show edit++completionNoCommandTest ::+  String ->+  [T.Text] ->+  Position ->+  T.Text ->+  TestTree+completionNoCommandTest name src pos wanted = testSession name $ do+  docId <- createDoc "A.hs" "haskell" (T.unlines src)+  _ <- waitForDiagnostics+  compls <- getCompletions docId pos+  let wantedC = find ( \case+            CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x+            _                                     -> False+            ) compls+  case wantedC of+    Nothing ->+      liftIO $ assertFailure $ "Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls]+    Just CompletionItem{..} -> liftIO . assertBool ("Expected no command but got: " <> show _command) $ null _command+++codeActionTests :: TestTree+codeActionTests = testGroup "code actions"+  [ suggestImportDisambiguationTests+  , insertImportTests+  , extendImportTests+  , renameActionTests+  , typeWildCardActionTests+  , removeImportTests+  , suggestImportClassMethodTests+  , suggestImportTests+  , suggestHideShadowTests+  , fixConstructorImportTests+  , fixModuleImportTypoTests+  , importRenameActionTests+  , fillTypedHoleTests+  , addSigActionTests+  , insertNewDefinitionTests+  , deleteUnusedDefinitionTests+  , addInstanceConstraintTests+  , addFunctionConstraintTests+  , removeRedundantConstraintsTests+  , addTypeAnnotationsToLiteralsTest+  , exportUnusedTests+  , addImplicitParamsConstraintTests+  , removeExportTests+  ]++insertImportTests :: TestTree+insertImportTests = testGroup "insert import"+  [ checkImport+        "module where keyword lower in file no exports"+        "WhereKeywordLowerInFileNoExports.hs"+        "WhereKeywordLowerInFileNoExports.expected.hs"+        "import Data.Int"+  , checkImport+        "module where keyword lower in file with exports"+        "WhereDeclLowerInFile.hs"+        "WhereDeclLowerInFile.expected.hs"+        "import Data.Int"+  , checkImport+        "module where keyword lower in file with comments before it"+        "WhereDeclLowerInFileWithCommentsBeforeIt.hs"+        "WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs"+        "import Data.Int"+  , expectFailBecause+      "'findNextPragmaPosition' function doesn't account for case when shebang is not placed at top of file"+      (checkImport+         "Shebang not at top with spaces"+         "ShebangNotAtTopWithSpaces.hs"+         "ShebangNotAtTopWithSpaces.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      "'findNextPragmaPosition' function doesn't account for case when shebang is not placed at top of file"+      (checkImport+         "Shebang not at top no space"+         "ShebangNotAtTopNoSpace.hs"+         "ShebangNotAtTopNoSpace.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      ("'findNextPragmaPosition' function doesn't account for case "+      ++ "when OPTIONS_GHC pragma is not placed at top of file")+      (checkImport+         "OPTIONS_GHC pragma not at top with spaces"+         "OptionsNotAtTopWithSpaces.hs"+         "OptionsNotAtTopWithSpaces.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      ("'findNextPragmaPosition' function doesn't account for "+      ++ "case when shebang is not placed at top of file")+      (checkImport+         "Shebang not at top of file"+         "ShebangNotAtTop.hs"+         "ShebangNotAtTop.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      ("'findNextPragmaPosition' function doesn't account for case "+      ++ "when OPTIONS_GHC is not placed at top of file")+      (checkImport+         "OPTIONS_GHC pragma not at top of file"+         "OptionsPragmaNotAtTop.hs"+         "OptionsPragmaNotAtTop.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      ("'findNextPragmaPosition' function doesn't account for case when "+      ++ "OPTIONS_GHC pragma is not placed at top of file")+      (checkImport+         "pragma not at top with comment at top"+         "PragmaNotAtTopWithCommentsAtTop.hs"+         "PragmaNotAtTopWithCommentsAtTop.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      ("'findNextPragmaPosition' function doesn't account for case when "+      ++ "OPTIONS_GHC pragma is not placed at top of file")+      (checkImport+         "pragma not at top multiple comments"+         "PragmaNotAtTopMultipleComments.hs"+         "PragmaNotAtTopMultipleComments.expected.hs"+         "import Data.Monoid")+  , expectFailBecause+      "'findNextPragmaPosition' function doesn't account for case of multiline pragmas"+      (checkImport+         "after multiline language pragmas"+         "MultiLinePragma.hs"+         "MultiLinePragma.expected.hs"+         "import Data.Monoid")+  , checkImport+      "pragmas not at top with module declaration"+      "PragmaNotAtTopWithModuleDecl.hs"+      "PragmaNotAtTopWithModuleDecl.expected.hs"+      "import Data.Monoid"+  , checkImport+      "pragmas not at top with imports"+      "PragmaNotAtTopWithImports.hs"+      "PragmaNotAtTopWithImports.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above comment at top of module"+      "CommentAtTop.hs"+      "CommentAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above multiple comments below"+      "CommentAtTopMultipleComments.hs"+      "CommentAtTopMultipleComments.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above curly brace comment"+      "CommentCurlyBraceAtTop.hs"+      "CommentCurlyBraceAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above multi-line comment"+      "MultiLineCommentAtTop.hs"+      "MultiLineCommentAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above comment with no module explicit exports"+      "NoExplicitExportCommentAtTop.hs"+      "NoExplicitExportCommentAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above two-dash comment with no pipe"+      "TwoDashOnlyComment.hs"+      "TwoDashOnlyComment.expected.hs"+      "import Data.Monoid"+  , checkImport+      "above comment with no (module .. where) decl"+      "NoModuleDeclarationCommentAtTop.hs"+      "NoModuleDeclarationCommentAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "comment not at top with no (module .. where) decl"+      "NoModuleDeclaration.hs"+      "NoModuleDeclaration.expected.hs"+      "import Data.Monoid"+  , checkImport+      "comment not at top (data dec is)"+      "DataAtTop.hs"+      "DataAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "comment not at top (newtype is)"+      "NewTypeAtTop.hs"+      "NewTypeAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with no explicit module exports"+      "NoExplicitExports.hs"+      "NoExplicitExports.expected.hs"+      "import Data.Monoid"+  , checkImport+      "add to correctly placed exisiting import"+      "ImportAtTop.hs"+      "ImportAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "add to multiple correctly placed exisiting imports"+      "MultipleImportsAtTop.hs"+      "MultipleImportsAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with language pragma at top of module"+      "LangPragmaModuleAtTop.hs"+      "LangPragmaModuleAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with language pragma and explicit module exports"+      "LangPragmaModuleWithComment.hs"+      "LangPragmaModuleWithComment.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with language pragma at top and no module declaration"+      "LanguagePragmaAtTop.hs"+      "LanguagePragmaAtTop.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with multiple lang pragmas and no module declaration"+      "MultipleLanguagePragmasNoModuleDeclaration.hs"+      "MultipleLanguagePragmasNoModuleDeclaration.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with pragmas and shebangs"+      "LanguagePragmasThenShebangs.hs"+      "LanguagePragmasThenShebangs.expected.hs"+      "import Data.Monoid"+  , checkImport+      "with pragmas and shebangs but no comment at top"+      "PragmasAndShebangsNoComment.hs"+      "PragmasAndShebangsNoComment.expected.hs"+      "import Data.Monoid"+  , checkImport+      "module decl no exports under pragmas and shebangs"+      "PragmasShebangsAndModuleDecl.hs"+      "PragmasShebangsAndModuleDecl.expected.hs"+      "import Data.Monoid"+  , checkImport+      "module decl with explicit import under pragmas and shebangs"+      "PragmasShebangsModuleExplicitExports.hs"+      "PragmasShebangsModuleExplicitExports.expected.hs"+      "import Data.Monoid"+  , checkImport+      "module decl and multiple imports"+      "ModuleDeclAndImports.hs"+      "ModuleDeclAndImports.expected.hs"+      "import Data.Monoid"+  ]++checkImport :: String -> FilePath -> FilePath -> T.Text -> TestTree+checkImport testComment originalPath expectedPath action =+  testSessionWithExtraFiles "import-placement" testComment $ \dir ->+    check (dir </> originalPath) (dir </> expectedPath) action+  where+    check :: FilePath -> FilePath -> T.Text -> Session ()+    check originalPath expectedPath action = do+      oSrc <- liftIO $ readFileUtf8 originalPath+      eSrc <- liftIO $  readFileUtf8 expectedPath+      originalDoc <- createDoc originalPath "haskell" oSrc+      _ <- waitForDiagnostics+      shouldBeDoc <- createDoc expectedPath "haskell" eSrc+      actionsOrCommands <- getAllCodeActions originalDoc+      chosenAction <- liftIO $ pickActionWithTitle action actionsOrCommands+      executeCodeAction chosenAction+      originalDocAfterAction <- documentContents originalDoc+      shouldBeDocContents <- documentContents shouldBeDoc+      liftIO $ T.replace "\r\n" "\n" shouldBeDocContents @=? T.replace "\r\n" "\n" originalDocAfterAction++renameActionTests :: TestTree+renameActionTests = testGroup "rename actions"+  [ testSession "change to local variable name" $ do+      let content = T.unlines+            [ "module Testing where"+            , "foo :: Int -> Int"+            , "foo argName = argNme"+            ]+      doc <- createDoc "Testing.hs" "haskell" content+      _ <- waitForDiagnostics+      action <- findCodeAction doc (Range (Position 2 14) (Position 2 20)) "Replace with ‘argName’"+      executeCodeAction action+      contentAfterAction <- documentContents doc+      let expectedContentAfterAction = T.unlines+            [ "module Testing where"+            , "foo :: Int -> Int"+            , "foo argName = argName"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "change to name of imported function" $ do+      let content = T.unlines+            [ "module Testing where"+            , "import Data.Maybe (maybeToList)"+            , "foo :: Maybe a -> [a]"+            , "foo = maybToList"+            ]+      doc <- createDoc "Testing.hs" "haskell" content+      _ <- waitForDiagnostics+      action <- findCodeAction doc (Range (Position 3 6) (Position 3 16))  "Replace with ‘maybeToList’"+      executeCodeAction action+      contentAfterAction <- documentContents doc+      let expectedContentAfterAction = T.unlines+            [ "module Testing where"+            , "import Data.Maybe (maybeToList)"+            , "foo :: Maybe a -> [a]"+            , "foo = maybeToList"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "suggest multiple local variable names" $ do+      let content = T.unlines+            [ "module Testing where"+            , "foo :: Char -> Char -> Char -> Char"+            , "foo argument1 argument2 argument3 = argumentX"+            ]+      doc <- createDoc "Testing.hs" "haskell" content+      _ <- waitForDiagnostics+      _ <- findCodeActions doc (Range (Position 2 36) (Position 2 45))+                           ["Replace with ‘argument1’", "Replace with ‘argument2’", "Replace with ‘argument3’"]+      return()+  , testSession "change infix function" $ do+      let content = T.unlines+            [ "module Testing where"+            , "monus :: Int -> Int"+            , "monus x y = max 0 (x - y)"+            , "foo x y = x `monnus` y"+            ]+      doc <- createDoc "Testing.hs" "haskell" content+      _ <- waitForDiagnostics+      actionsOrCommands <- getCodeActions doc (Range (Position 3 12) (Position 3 20))+      [fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "monus" `T.isInfixOf` actionTitle ]+      executeCodeAction fixTypo+      contentAfterAction <- documentContents doc+      let expectedContentAfterAction = T.unlines+            [ "module Testing where"+            , "monus :: Int -> Int"+            , "monus x y = max 0 (x - y)"+            , "foo x y = x `monus` y"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  ]++typeWildCardActionTests :: TestTree+typeWildCardActionTests = testGroup "type wildcard actions"+  [ testUseTypeSignature "global signature"+        [ "func :: _"+        , "func x = x"+        ]+        [ "func :: p -> p"+        , "func x = x"+        ]+  , testUseTypeSignature "local signature"+        [ "func :: Int -> Int"+        , "func x ="+        , "  let y :: _"+        , "      y = x * 2"+        , "  in y"+        ]+        [ "func :: Int -> Int"+        , "func x ="+        , "  let y :: Int"+        , "      y = x * 2"+        , "  in y"+        ]+  , testUseTypeSignature "multi-line message 1"+        [ "func :: _"+        , "func x y = x + y"+        ]+        [ "func :: Integer -> Integer -> Integer"+        , "func x y = x + y"+        ]+  , testUseTypeSignature "type in parentheses"+        [ "func :: a -> _"+        , "func x = (x, const x)"+        ]+        [ "func :: a -> (a, b -> a)"+        , "func x = (x, const x)"+        ]+  , testUseTypeSignature "type in brackets"+        [ "func :: _ -> Maybe a"+        , "func xs = head xs"+        ]+        [ "func :: [Maybe a] -> Maybe a"+        , "func xs = head xs"+        ]+  , testUseTypeSignature "unit type"+        [ "func :: IO _"+        , "func = putChar 'H'"+        ]+        [ "func :: IO ()"+        , "func = putChar 'H'"+        ]+  , testUseTypeSignature "no spaces around '::'"+        [ "func::_"+        , "func x y = x + y"+        ]+        [ "func::Integer -> Integer -> Integer"+        , "func x y = x + y"+        ]+  , testGroup "add parens if hole is part of bigger type"+    [ testUseTypeSignature "subtype 1"+          [ "func :: _ -> Integer -> Integer"+          , "func x y = x + y"+          ]+          [ "func :: Integer -> Integer -> Integer"+          , "func x y = x + y"+          ]+    , testUseTypeSignature "subtype 2"+          [ "func :: Integer -> _ -> Integer"+          , "func x y = x + y"+          ]+          [ "func :: Integer -> Integer -> Integer"+          , "func x y = x + y"+          ]+    , testUseTypeSignature "subtype 3"+          [ "func :: Integer -> Integer -> _"+          , "func x y = x + y"+          ]+          [ "func :: Integer -> Integer -> Integer"+          , "func x y = x + y"+          ]+    , testUseTypeSignature "subtype 4"+          [ "func :: Integer -> _"+          , "func x y = x + y"+          ]+          [ "func :: Integer -> (Integer -> Integer)"+          , "func x y = x + y"+          ]+    ]+  ]+  where+    -- | Test session of given name, checking action "Use type signature..."+    --   on a test file with given content and comparing to expected result.+    testUseTypeSignature name textIn textOut = testSession name $ do+        let fileStart = "module Testing where"+            content = T.unlines $ fileStart : textIn+            expectedContentAfterAction = T.unlines $ fileStart : textOut+        doc <- createDoc "Testing.hs" "haskell" content+        _ <- waitForDiagnostics+        actionsOrCommands <- getAllCodeActions doc+        let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands+                                    , "Use type signature" `T.isInfixOf` actionTitle+                            ]+        executeCodeAction addSignature+        contentAfterAction <- documentContents doc+        liftIO $ expectedContentAfterAction @=? contentAfterAction++{-# HLINT ignore "Use nubOrd" #-}+removeImportTests :: TestTree+removeImportTests = testGroup "remove import actions"+  [ testSession "redundant" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA"+            , "stuffB :: Integer"+            , "stuffB = 123"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "stuffB :: Integer"+            , "stuffB = 123"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "qualified redundant" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import qualified ModuleA"+            , "stuffB :: Integer"+            , "stuffB = 123"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "stuffB :: Integer"+            , "stuffB = 123"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "redundant binding" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            , "stuffA = False"+            , "stuffB :: Integer"+            , "stuffB = 123"+            , "stuffC = ()"+            , "_stuffD = '_'"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (stuffA, stuffB, _stuffD, stuffC, stuffA)"+            , "main = print stuffB"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove _stuffD, stuffA, stuffC from import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (stuffB)"+            , "main = print stuffB"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "redundant binding - unicode regression " $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            , "data A = A"+            , "ε :: Double"+            , "ε = 0.5"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (A(..), ε)"+            , "a = A"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove ε from import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (A(..))"+            , "a = A"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "redundant operator" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            , "a !! _b = a"+            , "a <?> _b = a"+            , "stuffB :: Integer"+            , "stuffB = 123"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import qualified ModuleA as A ((<?>), stuffB, (!!))"+            , "main = print A.stuffB"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove !!, <?> from import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import qualified ModuleA as A (stuffB)"+            , "main = print A.stuffB"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "redundant all import" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            , "data A = A"+            , "stuffB :: Integer"+            , "stuffB = 123"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (A(..), stuffB)"+            , "main = print stuffB"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove A from import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (stuffB)"+            , "main = print stuffB"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "redundant constructor import" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            , "data D = A | B"+            , "data E = F"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (D(A,B), E(F))"+            , "main = B"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove A, E, F from import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (D(B))"+            , "main = B"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "import containing the identifier Strict" $ do+      let contentA = T.unlines+            [ "module Strict where"+            ]+      _docA <- createDoc "Strict.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import Strict"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "remove all" $ do+      let content = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleA where"+            , "import Data.Function (fix, (&))"+            , "import qualified Data.Functor.Const"+            , "import Data.Functor.Identity"+            , "import Data.Functor.Sum (Sum (InL, InR))"+            , "import qualified Data.Kind as K (Constraint, Type)"+            , "x = InL (Identity 123)"+            , "y = fix id"+            , "type T = K.Type"+            ]+      doc <- createDoc "ModuleC.hs" "haskell" content+      _ <- waitForDiagnostics+      [_, _, _, _, InR action@CodeAction { _title = actionTitle }]+          <- nub <$> getAllCodeActions doc+      liftIO $ "Remove all redundant imports" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents doc+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleA where"+            , "import Data.Function (fix)"+            , "import Data.Functor.Identity"+            , "import Data.Functor.Sum (Sum (InL))"+            , "import qualified Data.Kind as K (Type)"+            , "x = InL (Identity 123)"+            , "y = fix id"+            , "type T = K.Type"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  , testSession "remove unused operators whose name ends with '.'" $ do+      let contentA = T.unlines+            [ "module ModuleA where"+            , "(@.) = 0 -- Must have an operator whose name ends with '.'"+            , "a = 1 -- .. but also something else"+            ]+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      let contentB = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (a, (@.))"+            , "x = a -- Must use something from module A, but not (@.)"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" contentB+      _ <- waitForDiagnostics+      [InR action@CodeAction { _title = actionTitle }, _]+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))+      liftIO $ "Remove @. from import" @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      let expectedContentAfterAction = T.unlines+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"+            , "module ModuleB where"+            , "import ModuleA (a)"+            , "x = a -- Must use something from module A, but not (@.)"+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction+  ]++extendImportTests :: TestTree+extendImportTests = testGroup "extend import actions"+  [ testGroup "with checkAll" $ tests True+  , testGroup "without checkAll" $ tests False+  ]+  where+    tests overrideCheckProject =+        [ testSession "extend all constructors for record field" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data A = B { a :: Int }"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A(B))"+                    , "f = a"+                    ])+            (Range (Position 2 4) (Position 2 5))+            [ "Add A(..) to the import list of ModuleA"+            , "Add A(a) to the import list of ModuleA"+            , "Add a to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A(..))"+                    , "f = a"+                    ])+        , testSession "extend all constructors with sibling" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data Foo"+                    , "data Bar"+                    , "data A = B | C"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA ( Foo,  A (C) , Bar ) "+                    , "f = B"+                    ])+            (Range (Position 2 4) (Position 2 5))+            [ "Add A(..) to the import list of ModuleA"+            , "Add A(B) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA ( Foo,  A (..) , Bar ) "+                    , "f = B"+                    ])+        , testSession "extend all constructors with comment" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data Foo"+                    , "data Bar"+                    , "data A = B | C"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA ( Foo,  A (C{-comment--}) , Bar ) "+                    , "f = B"+                    ])+            (Range (Position 2 4) (Position 2 5))+            [ "Add A(..) to the import list of ModuleA"+            , "Add A(B) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA ( Foo,  A (..{-comment--}) , Bar ) "+                    , "f = B"+                    ])+        , testSession "extend all constructors for type operator" $ template+            []+            ("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "import Data.Type.Equality ((:~:))"+                    , "x :: (:~:) [] []"+                    , "x = Refl"+                    ])+            (Range (Position 3 17) (Position 3 18))+            [ "Add (:~:)(..) to the import list of Data.Type.Equality"+            , "Add type (:~:)(Refl) to the import list of Data.Type.Equality"]+            (T.unlines+                    [ "module ModuleA where"+                    , "import Data.Type.Equality ((:~:) (..))"+                    , "x :: (:~:) [] []"+                    , "x = Refl"+                    ])+        , testSession "extend all constructors for class" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "class C a where"+                    , "  m1 :: a -> a"+                    , "  m2 :: a -> a"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (C(m1))"+                    , "b = m2"+                    ])+            (Range (Position 2 5) (Position 2 5))+            [ "Add C(..) to the import list of ModuleA"+            , "Add C(m2) to the import list of ModuleA"+            , "Add m2 to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (C(..))"+                    , "b = m2"+                    ])+        , testSession "extend single line import with value" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "stuffA :: Double"+                    , "stuffA = 0.00750"+                    , "stuffB :: Integer"+                    , "stuffB = 123"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA as A (stuffB)"+                    , "main = print (stuffA, stuffB)"+                    ])+            (Range (Position 2 17) (Position 2 18))+            ["Add stuffA to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA as A (stuffB, stuffA)"+                    , "main = print (stuffA, stuffB)"+                    ])+        , testSession "extend single line import with operator" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "(.*) :: Integer -> Integer -> Integer"+                    , "x .* y = x * y"+                    , "stuffB :: Integer"+                    , "stuffB = 123"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA as A (stuffB)"+                    , "main = print (stuffB .* stuffB)"+                    ])+            (Range (Position 2 17) (Position 2 18))+            ["Add (.*) to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA as A (stuffB, (.*))"+                    , "main = print (stuffB .* stuffB)"+                    ])+        , testSession "extend single line import with infix constructor" $ template+            []+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import Data.List.NonEmpty (fromList)"+                    , "main = case (fromList []) of _ :| _ -> pure ()"+                    ])+            (Range (Position 2 5) (Position 2 6))+            [ "Add NonEmpty((:|)) to the import list of Data.List.NonEmpty"+            , "Add NonEmpty(..) to the import list of Data.List.NonEmpty"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import Data.List.NonEmpty (fromList, NonEmpty ((:|)))"+                    , "main = case (fromList []) of _ :| _ -> pure ()"+                    ])+        , testSession "extend single line import with prefix constructor" $ template+            []+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import Prelude hiding (Maybe(..))"+                    , "import Data.Maybe (catMaybes)"+                    , "x = Just 10"+                    ])+            (Range (Position 3 5) (Position 2 6))+            [ "Add Maybe(Just) to the import list of Data.Maybe"+            , "Add Maybe(..) to the import list of Data.Maybe"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import Prelude hiding (Maybe(..))"+                    , "import Data.Maybe (catMaybes, Maybe (Just))"+                    , "x = Just 10"+                    ])+        , testSession "extend single line import with type" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "type A = Double"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA ()"+                    , "b :: A"+                    , "b = 0"+                    ])+            (Range (Position 2 5) (Position 2 5))+            ["Add A to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A)"+                    , "b :: A"+                    , "b = 0"+                    ])+        , testSession "extend single line import with constructor" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data A = Constructor"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A)"+                    , "b :: A"+                    , "b = Constructor"+                    ])+            (Range (Position 3 5) (Position 3 5))+            [ "Add A(Constructor) to the import list of ModuleA"+            , "Add A(..) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A (Constructor))"+                    , "b :: A"+                    , "b = Constructor"+                    ])+        , testSession "extend single line import with constructor (with comments)" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data A = Constructor"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A ({-Constructor-}))"+                    , "b :: A"+                    , "b = Constructor"+                    ])+            (Range (Position 3 5) (Position 3 5))+            [ "Add A(Constructor) to the import list of ModuleA"+            , "Add A(..) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A (Constructor{-Constructor-}))"+                    , "b :: A"+                    , "b = Constructor"+                    ])+        , testSession "extend single line import with mixed constructors" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data A = ConstructorFoo | ConstructorBar"+                    , "a = 1"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A (ConstructorBar), a)"+                    , "b :: A"+                    , "b = ConstructorFoo"+                    ])+            (Range (Position 3 5) (Position 3 5))+            [ "Add A(ConstructorFoo) to the import list of ModuleA"+            , "Add A(..) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (A (ConstructorBar, ConstructorFoo), a)"+                    , "b :: A"+                    , "b = ConstructorFoo"+                    ])+        , testSession "extend single line qualified import with value" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "stuffA :: Double"+                    , "stuffA = 0.00750"+                    , "stuffB :: Integer"+                    , "stuffB = 123"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import qualified ModuleA as A (stuffB)"+                    , "main = print (A.stuffA, A.stuffB)"+                    ])+            (Range (Position 2 17) (Position 2 18))+            ["Add stuffA to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import qualified ModuleA as A (stuffB, stuffA)"+                    , "main = print (A.stuffA, A.stuffB)"+                    ])+        , testSession "extend multi line import with value" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "stuffA :: Double"+                    , "stuffA = 0.00750"+                    , "stuffB :: Integer"+                    , "stuffB = 123"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (stuffB"+                    , "               )"+                    , "main = print (stuffA, stuffB)"+                    ])+            (Range (Position 3 17) (Position 3 18))+            ["Add stuffA to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (stuffB, stuffA"+                    , "               )"+                    , "main = print (stuffA, stuffB)"+                    ])+        , testSession "extend multi line import with trailing comma" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "stuffA :: Double"+                    , "stuffA = 0.00750"+                    , "stuffB :: Integer"+                    , "stuffB = 123"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (stuffB,"+                    , "               )"+                    , "main = print (stuffA, stuffB)"+                    ])+            (Range (Position 3 17) (Position 3 18))+            ["Add stuffA to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (stuffB, stuffA,"+                    , "               )"+                    , "main = print (stuffA, stuffB)"+                    ])+        , testSession "extend single line import with method within class" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "class C a where"+                    , "  m1 :: a -> a"+                    , "  m2 :: a -> a"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (C(m1))"+                    , "b = m2"+                    ])+            (Range (Position 2 5) (Position 2 5))+            [ "Add C(m2) to the import list of ModuleA"+            , "Add m2 to the import list of ModuleA"+            , "Add C(..) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (C(m1, m2))"+                    , "b = m2"+                    ])+        , testSession "extend single line import with method without class" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "class C a where"+                    , "  m1 :: a -> a"+                    , "  m2 :: a -> a"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (C(m1))"+                    , "b = m2"+                    ])+            (Range (Position 2 5) (Position 2 5))+            [ "Add m2 to the import list of ModuleA"+            , "Add C(m2) to the import list of ModuleA"+            , "Add C(..) to the import list of ModuleA"+            ]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA (C(m1), m2)"+                    , "b = m2"+                    ])+        , testSession "extend import list with multiple choices" $ template+            [("ModuleA.hs", T.unlines+                    --  this is just a dummy module to help the arguments needed for this test+                    [  "module ModuleA (bar) where"+                    , "bar = 10"+                    ]),+            ("ModuleB.hs", T.unlines+                    --  this is just a dummy module to help the arguments needed for this test+                    [  "module ModuleB (bar) where"+                    , "bar = 10"+                    ])]+            ("ModuleC.hs", T.unlines+                    [ "module ModuleC where"+                    , "import ModuleB ()"+                    , "import ModuleA ()"+                    , "foo = bar"+                    ])+            (Range (Position 3 17) (Position 3 18))+            ["Add bar to the import list of ModuleA",+            "Add bar to the import list of ModuleB"]+            (T.unlines+                    [ "module ModuleC where"+                    , "import ModuleB ()"+                    , "import ModuleA (bar)"+                    , "foo = bar"+                    ])+        , testSession "extend import list with constructor of type operator" $ template+            []+            ("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "import Data.Type.Equality ((:~:))"+                    , "x :: (:~:) [] []"+                    , "x = Refl"+                    ])+            (Range (Position 3 17) (Position 3 18))+            [ "Add type (:~:)(Refl) to the import list of Data.Type.Equality"+            , "Add (:~:)(..) to the import list of Data.Type.Equality"]+            (T.unlines+                    [ "module ModuleA where"+                    , "import Data.Type.Equality ((:~:) (Refl))"+                    , "x :: (:~:) [] []"+                    , "x = Refl"+                    ])+        , expectFailBecause "importing pattern synonyms is unsupported"+          $ testSession "extend import list with pattern synonym" $ template+            [("ModuleA.hs", T.unlines+                    [ "{-# LANGUAGE PatternSynonyms #-}"+                      , "module ModuleA where"+                      , "pattern Some x = Just x"+                    ])+            ]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import A ()"+                    , "k (Some x) = x"+                    ])+            (Range (Position 2 3) (Position 2 7))+            ["Add pattern Some to the import list of A"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import A (pattern Some)"+                    , "k (Some x) = x"+                    ])+        , ignoreForGHC92 "Diagnostic message has no suggestions" $+          testSession "type constructor name same as data constructor name" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "newtype Foo = Foo Int"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA(Foo)"+                    , "f :: Foo"+                    , "f = Foo 1"+                    ])+            (Range (Position 3 4) (Position 3 6))+            ["Add Foo(Foo) to the import list of ModuleA", "Add Foo(..) to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA(Foo (Foo))"+                    , "f :: Foo"+                    , "f = Foo 1"+                    ])+        , testSession "type constructor name same as data constructor name, data constructor extraneous" $ template+            [("ModuleA.hs", T.unlines+                    [ "module ModuleA where"+                    , "data Foo = Foo"+                    ])]+            ("ModuleB.hs", T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA()"+                    , "f :: Foo"+                    , "f = undefined"+                    ])+            (Range (Position 2 4) (Position 2 6))+            ["Add Foo to the import list of ModuleA"]+            (T.unlines+                    [ "module ModuleB where"+                    , "import ModuleA(Foo)"+                    , "f :: Foo"+                    , "f = undefined"+                    ])+        ]+      where+        codeActionTitle CodeAction{_title=x} = x++        template setUpModules moduleUnderTest range expectedTitles expectedContentB = do+            configureCheckProject overrideCheckProject++            mapM_ (\x -> createDoc (fst x) "haskell" (snd x)) setUpModules+            docB <- createDoc (fst moduleUnderTest) "haskell" (snd moduleUnderTest)+            _  <- waitForDiagnostics+            waitForProgressDone+            actionsOrCommands <- getCodeActions docB range+            let codeActions =+                  filter+                    (T.isPrefixOf "Add" . codeActionTitle)+                    [ca | InR ca <- actionsOrCommands]+                actualTitles = codeActionTitle <$> codeActions+            -- Note that we are not testing the order of the actions, as the+            -- order of the expected actions indicates which one we'll execute+            -- in this test, i.e., the first one.+            liftIO $ sort expectedTitles @=? sort actualTitles++            -- Execute the action with the same title as the first expected one.+            -- Since we tested that both lists have the same elements (possibly+            -- in a different order), this search cannot fail.+            let firstTitle:_ = expectedTitles+                action = fromJust $+                  find ((firstTitle ==) . codeActionTitle) codeActions+            executeCodeAction action+            contentAfterAction <- documentContents docB+            liftIO $ expectedContentB @=? contentAfterAction++fixModuleImportTypoTests :: TestTree+fixModuleImportTypoTests = testGroup "fix module import typo"+    [ testSession "works when single module suggested" $ do+        doc <- createDoc "A.hs" "haskell" "import Data.Cha"+        _ <- waitForDiagnostics+        InR action@CodeAction { _title = actionTitle } : _  <- getCodeActions doc (R 0 0 0 10)+        liftIO $ actionTitle @?= "replace with Data.Char"+        executeCodeAction action+        contentAfterAction <- documentContents doc+        liftIO $ contentAfterAction @?= "import Data.Char"+    , testSession "works when multiple modules suggested" $ do+        doc <- createDoc "A.hs" "haskell" "import Data.I"+        _ <- waitForDiagnostics+        actions <- sortOn (\(InR CodeAction{_title=x}) -> x) <$> getCodeActions doc (R 0 0 0 10)+        let actionTitles = [ title | InR CodeAction{_title=title} <- actions ]+        liftIO $ actionTitles @?= [ "replace with Data.Eq"+                                  , "replace with Data.Int"+                                  , "replace with Data.Ix"+                                  ]+        let InR replaceWithDataEq : _ = actions+        executeCodeAction replaceWithDataEq+        contentAfterAction <- documentContents doc+        liftIO $ contentAfterAction @?= "import Data.Eq"+    ]++suggestImportClassMethodTests :: TestTree+suggestImportClassMethodTests =+  testGroup+    "suggest import class methods"+    [ testGroup+        "new"+        [ testSession "via parent" $+            template'+            "import Data.Semigroup (Semigroup(stimes))"+            (Range (Position 4 2) (Position 4 8)),+          testSession "top level" $+            template'+              "import Data.Semigroup (stimes)"+              (Range (Position 4 2) (Position 4 8)),+          testSession "all" $+            template'+              "import Data.Semigroup"+              (Range (Position 4 2) (Position 4 8))+        ],+      testGroup+        "extend"+        [ testSession "via parent" $+            template+              [ "module A where",+                "",+                "import Data.Semigroup ()"+              ]+              (Range (Position 6 2) (Position 6 8))+              "Add Semigroup(stimes) to the import list of Data.Semigroup"+              [ "module A where",+                "",+                "import Data.Semigroup (Semigroup (stimes))"+              ],+          testSession "top level" $+            template+              [ "module A where",+                "",+                "import Data.Semigroup ()"+              ]+              (Range (Position 6 2) (Position 6 8))+              "Add stimes to the import list of Data.Semigroup"+              [ "module A where",+                "",+                "import Data.Semigroup (stimes)"+              ]+        ]+    ]+  where+    decls =+      [ "data X = X",+        "instance Semigroup X where",+        "  (<>) _ _ = X",+        "  stimes _ _ = X"+      ]+    template beforeContent range executeTitle expectedContent = do+      doc <- createDoc "A.hs" "haskell" $ T.unlines (beforeContent <> decls)+      _ <- waitForDiagnostics+      waitForProgressDone+      actions <- getCodeActions doc range+      let actions' = [x | InR x <- actions]+          titles = [_title | CodeAction {_title} <- actions']+      liftIO $ executeTitle `elem` titles @? T.unpack executeTitle <> " does not in " <> show titles+      executeCodeAction $ fromJust $ find (\CodeAction {_title} -> _title == executeTitle) actions'+      content <- documentContents doc+      liftIO $ T.unlines (expectedContent <> decls) @=? content+    template' executeTitle range = let c = ["module A where"] in template c range executeTitle $ c <> [executeTitle]++suggestImportTests :: TestTree+suggestImportTests = testGroup "suggest import actions"+  [ testGroup "Dont want suggestion"+    [ -- extend import+      test False ["Data.List.NonEmpty ()"] "f = nonEmpty" []                "import Data.List.NonEmpty (nonEmpty)"+      -- data constructor+    , test False []                        "f = First"    []                "import Data.Monoid (First)"+      -- internal module+    , test False []         "f :: Typeable a => a"        ["f = undefined"] "import Data.Typeable.Internal (Typeable)"+      -- package not in scope+    , test False []         "f = quickCheck"              []                "import Test.QuickCheck (quickCheck)"+      -- don't omit the parent data type of a constructor+    , test False []         "f ExitSuccess = ()"          []                "import System.Exit (ExitSuccess)"+      -- don't suggest data constructor when we only need the type+    , test False []         "f :: Bar"                    []                "import Bar (Bar(Bar))"+      -- don't suggest all data constructors for the data type+    , test False []         "f :: Bar"                    []                "import Bar (Bar(..))"+    ]+  , testGroup "want suggestion"+    [ wantWait  []          "f = foo"                     []                "import Foo (foo)"+    , wantWait  []          "f = Bar"                     []                "import Bar (Bar(Bar))"+    , wantWait  []          "f :: Bar"                    []                "import Bar (Bar)"+    , wantWait  []          "f = Bar"                     []                "import Bar (Bar(..))"+    , test True []          "f = nonEmpty"                []                "import Data.List.NonEmpty (nonEmpty)"+    , test True []          "f = (:|)"                    []                "import Data.List.NonEmpty (NonEmpty((:|)))"+    , test True []          "f :: Natural"                ["f = undefined"] "import Numeric.Natural (Natural)"+    , test True []          "f :: Natural"                ["f = undefined"] "import Numeric.Natural"+    , test True []          "f :: NonEmpty ()"            ["f = () :| []"]  "import Data.List.NonEmpty (NonEmpty)"+    , test True []          "f :: NonEmpty ()"            ["f = () :| []"]  "import Data.List.NonEmpty"+    , test True []          "f = First"                   []                "import Data.Monoid (First(First))"+    , test True []          "f = Endo"                    []                "import Data.Monoid (Endo(Endo))"+    , test True []          "f = Version"                 []                "import Data.Version (Version(Version))"+    , test True []          "f ExitSuccess = ()"          []                "import System.Exit (ExitCode(ExitSuccess))"+    , test True []          "f = AssertionFailed"         []                "import Control.Exception (AssertionFailed(AssertionFailed))"+    , test True ["Prelude"] "f = nonEmpty"                []                "import Data.List.NonEmpty (nonEmpty)"+    , test True []          "f :: Alternative f => f ()"  ["f = undefined"] "import Control.Applicative (Alternative)"+    , test True []          "f :: Alternative f => f ()"  ["f = undefined"] "import Control.Applicative"+    , test True []          "f = empty"                   []                "import Control.Applicative (Alternative(empty))"+    , test True []          "f = empty"                   []                "import Control.Applicative (empty)"+    , test True []          "f = empty"                   []                "import Control.Applicative"+    , test True []          "f = (&)"                     []                "import Data.Function ((&))"+    , test True []          "f = NE.nonEmpty"             []                "import qualified Data.List.NonEmpty as NE"+    , test True []          "f = Data.List.NonEmpty.nonEmpty" []            "import qualified Data.List.NonEmpty"+    , test True []          "f :: Typeable a => a"        ["f = undefined"] "import Data.Typeable (Typeable)"+    , test True []          "f = pack"                    []                "import Data.Text (pack)"+    , test True []          "f :: Text"                   ["f = undefined"] "import Data.Text (Text)"+    , test True []          "f = [] & id"                 []                "import Data.Function ((&))"+    , test True []          "f = (&) [] id"               []                "import Data.Function ((&))"+    , test True []          "f = (.|.)"                   []                "import Data.Bits (Bits((.|.)))"+    , test True []          "f = (.|.)"                   []                "import Data.Bits ((.|.))"+    , test True []          "f :: a ~~ b"                 []                "import Data.Type.Equality (type (~~))"+    , test True+      ["qualified Data.Text as T"+      ]                     "f = T.putStrLn"              []                "import qualified Data.Text.IO as T"+    , test True+      [ "qualified Data.Text as T"+      , "qualified Data.Function as T"+      ]                     "f = T.putStrLn"              []                "import qualified Data.Text.IO as T"+    , test True+      [ "qualified Data.Text as T"+      , "qualified Data.Function as T"+      , "qualified Data.Functor as T"+      , "qualified Data.Data as T"+      ]                     "f = T.putStrLn"              []                "import qualified Data.Text.IO as T"+    , test True []          "f = (.|.)"                   []                "import Data.Bits (Bits(..))"+    , test True []          "f = empty"                   []                "import Control.Applicative (Alternative(..))"+    ]+  , expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)"+  ]+  where+    test = test' False+    wantWait = test' True True++    test' waitForCheckProject wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do+      configureCheckProject waitForCheckProject+      let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other+          after  = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other+          cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo, B]}}"+      liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle+      liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["{-# LANGUAGE PatternSynonyms #-}", "module B where", "pattern Some x = Just x"]+      doc <- createDoc "Test.hs" "haskell" before+      waitForProgressDone+      _ <- waitForDiagnostics+      -- there isn't a good way to wait until the whole project is checked atm+      when waitForCheckProject $ liftIO $ sleep 0.5+      let defLine = fromIntegral $ length imps + 1+          range = Range (Position defLine 0) (Position defLine maxBound)+      actions <- getCodeActions doc range+      if wanted+         then do+             action <- liftIO $ pickActionWithTitle newImp actions+             executeCodeAction action+             contentAfterAction <- documentContents doc+             liftIO $ after @=? contentAfterAction+          else+              liftIO $ [_title | InR CodeAction{_title} <- actions, _title == newImp ] @?= []++suggestImportDisambiguationTests :: TestTree+suggestImportDisambiguationTests = testGroup "suggest import disambiguation actions"+  [ testGroup "Hiding strategy works"+    [ testGroup "fromList"+        [ testCase "AVec" $+            compareHideFunctionTo [(8,9),(10,8)]+                "Use AVec for fromList, hiding other imports"+                "HideFunction.expected.fromList.A.hs"+        , testCase "BVec" $+            compareHideFunctionTo [(8,9),(10,8)]+                "Use BVec for fromList, hiding other imports"+                "HideFunction.expected.fromList.B.hs"+        ]+    , testGroup "(++)"+        [ testCase "EVec" $+            compareHideFunctionTo [(8,9),(10,8)]+                "Use EVec for ++, hiding other imports"+                "HideFunction.expected.append.E.hs"+        , testCase "Hide functions without local" $+            compareTwo+                "HideFunctionWithoutLocal.hs" [(8,8)]+                "Use local definition for ++, hiding other imports"+                "HideFunctionWithoutLocal.expected.hs"+        , testCase "Prelude" $+            compareHideFunctionTo [(8,9),(10,8)]+                "Use Prelude for ++, hiding other imports"+                "HideFunction.expected.append.Prelude.hs"+        , testCase "Prelude and local definition, infix" $+            compareTwo+                "HidePreludeLocalInfix.hs" [(2,19)]+                "Use local definition for ++, hiding other imports"+                "HidePreludeLocalInfix.expected.hs"+        , testCase "AVec, indented" $+            compareTwo "HidePreludeIndented.hs" [(3,8)]+            "Use AVec for ++, hiding other imports"+            "HidePreludeIndented.expected.hs"++        ]+    , testGroup "Vec (type)"+        [ testCase "AVec" $+            compareTwo+                "HideType.hs" [(8,15)]+                "Use AVec for Vec, hiding other imports"+                "HideType.expected.A.hs"+        , testCase "EVec" $+            compareTwo+                "HideType.hs" [(8,15)]+                "Use EVec for Vec, hiding other imports"+                "HideType.expected.E.hs"+        ]+    ]+  , testGroup "Qualify strategy"+    [ testCase "won't suggest full name for qualified module" $+      withHideFunction [(8,9),(10,8)] $ \_ _ actions -> do+        liftIO $+            assertBool "EVec.fromList must not be suggested" $+                "Replace with qualified: EVec.fromList" `notElem`+                [ actionTitle+                | InR CodeAction { _title = actionTitle } <- actions+                ]+        liftIO $+            assertBool "EVec.++ must not be suggested" $+                "Replace with qualified: EVec.++" `notElem`+                [ actionTitle+                | InR CodeAction { _title = actionTitle } <- actions+                ]+    , testGroup "fromList"+        [ testCase "EVec" $+            compareHideFunctionTo [(8,9),(10,8)]+                "Replace with qualified: E.fromList"+                "HideFunction.expected.qualified.fromList.E.hs"+        , testCase "Hide DuplicateRecordFields" $+            compareTwo+                "HideQualifyDuplicateRecordFields.hs" [(9, 9)]+                "Replace with qualified: AVec.fromList"+                "HideQualifyDuplicateRecordFields.expected.hs"+        , testCase "Duplicate record fields should not be imported" $ do+          withTarget ("HideQualifyDuplicateRecordFields" <.> ".hs") [(9, 9)] $+            \_ _ actions -> do+              liftIO $+                assertBool "Hidings should not be presented while DuplicateRecordFields exists" $+                  all not [ actionTitle =~ T.pack "Use ([A-Za-z][A-Za-z0-9]*) for fromList, hiding other imports"+                      | InR CodeAction { _title = actionTitle } <- actions]+          withTarget ("HideQualifyDuplicateRecordFieldsSelf" <.> ".hs") [(4, 4)] $+            \_ _ actions -> do+              liftIO $+                assertBool "ambiguity from DuplicateRecordFields should not be imported" $+                  null actions+        ]+    , testGroup "(++)"+        [ testCase "Prelude, parensed" $+            compareHideFunctionTo [(8,9),(10,8)]+                "Replace with qualified: Prelude.++"+                "HideFunction.expected.qualified.append.Prelude.hs"+        , testCase "Prelude, infix" $+            compareTwo+                "HideQualifyInfix.hs" [(4,19)]+                "Replace with qualified: Prelude.++"+                "HideQualifyInfix.expected.hs"+        , testCase "Prelude, left section" $+            compareTwo+                "HideQualifySectionLeft.hs" [(4,15)]+                "Replace with qualified: Prelude.++"+                "HideQualifySectionLeft.expected.hs"+        , testCase "Prelude, right section" $+            compareTwo+                "HideQualifySectionRight.hs" [(4,18)]+                "Replace with qualified: Prelude.++"+                "HideQualifySectionRight.expected.hs"+        ]+    ]+  ]+  where+    compareTwo original locs cmd expected =+        withTarget original locs $ \dir doc actions -> do+            expected <- liftIO $+                readFileUtf8 (dir </> expected)+            action <- liftIO $ pickActionWithTitle cmd actions+            executeCodeAction action+            contentAfterAction <- documentContents doc+            liftIO $ T.replace "\r\n" "\n" expected @=? contentAfterAction+    compareHideFunctionTo = compareTwo "HideFunction.hs"+    auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"]+    withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do+        doc <- openDoc file "haskell"+        waitForProgressDone+        void $ expectDiagnostics [(file, [(DsError, loc, "Ambiguous occurrence") | loc <- locs])]+        actions <- getAllCodeActions doc+        k dir doc actions+    withHideFunction = withTarget ("HideFunction" <.> "hs")++suggestHideShadowTests :: TestTree+suggestHideShadowTests =+  testGroup+    "suggest hide shadow"+    [ testGroup+        "single"+        [ testOneCodeAction+            "hide unsued"+            "Hide on from Data.Function"+            (1, 2)+            (1, 4)+            [ "import Data.Function"+            , "f on = on"+            , "g on = on"+            ]+            [ "import Data.Function hiding (on)"+            , "f on = on"+            , "g on = on"+            ]+        , testOneCodeAction+            "extend hiding unsued"+            "Hide on from Data.Function"+            (1, 2)+            (1, 4)+            [ "import Data.Function hiding ((&))"+            , "f on = on"+            ]+            [ "import Data.Function hiding (on, (&))"+            , "f on = on"+            ]+        , testOneCodeAction+            "delete unsued"+            "Hide on from Data.Function"+            (1, 2)+            (1, 4)+            [ "import Data.Function ((&), on)"+            , "f on = on"+            ]+            [ "import Data.Function ((&))"+            , "f on = on"+            ]+        , testOneCodeAction+            "hide operator"+            "Hide & from Data.Function"+            (1, 2)+            (1, 5)+            [ "import Data.Function"+            , "f (&) = (&)"+            ]+            [ "import Data.Function hiding ((&))"+            , "f (&) = (&)"+            ]+        , testOneCodeAction+            "remove operator"+            "Hide & from Data.Function"+            (1, 2)+            (1, 5)+            [ "import Data.Function ((&), on)"+            , "f (&) = (&)"+            ]+            [ "import Data.Function ( on)"+            , "f (&) = (&)"+            ]+        , noCodeAction+            "don't remove already used"+            (2, 2)+            (2, 4)+            [ "import Data.Function"+            , "g = on"+            , "f on = on"+            ]+        ]+    , testGroup+        "multi"+        [ testOneCodeAction+            "hide from B"+            "Hide ++ from B"+            (2, 2)+            (2, 6)+            [ "import B"+            , "import C"+            , "f (++) = (++)"+            ]+            [ "import B hiding ((++))"+            , "import C"+            , "f (++) = (++)"+            ]+        , testOneCodeAction+            "hide from C"+            "Hide ++ from C"+            (2, 2)+            (2, 6)+            [ "import B"+            , "import C"+            , "f (++) = (++)"+            ]+            [ "import B"+            , "import C hiding ((++))"+            , "f (++) = (++)"+            ]+        , testOneCodeAction+            "hide from Prelude"+            "Hide ++ from Prelude"+            (2, 2)+            (2, 6)+            [ "import B"+            , "import C"+            , "f (++) = (++)"+            ]+            [ "import B"+            , "import C"+            , "import Prelude hiding ((++))"+            , "f (++) = (++)"+            ]+        , testMultiCodeActions+            "manual hide all"+            [ "Hide ++ from Prelude"+            , "Hide ++ from C"+            , "Hide ++ from B"+            ]+            (2, 2)+            (2, 6)+            [ "import B"+            , "import C"+            , "f (++) = (++)"+            ]+            [ "import B hiding ((++))"+            , "import C hiding ((++))"+            , "import Prelude hiding ((++))"+            , "f (++) = (++)"+            ]+        , testOneCodeAction+            "auto hide all"+            "Hide ++ from all occurence imports"+            (2, 2)+            (2, 6)+            [ "import B"+            , "import C"+            , "f (++) = (++)"+            ]+            [ "import B hiding ((++))"+            , "import C hiding ((++))"+            , "import Prelude hiding ((++))"+            , "f (++) = (++)"+            ]+        ]+    ]+ where+  testOneCodeAction testName actionName start end origin expected =+    helper testName start end origin expected $ \cas -> do+      action <- liftIO $ pickActionWithTitle actionName cas+      executeCodeAction action+  noCodeAction testName start end origin =+    helper testName start end origin origin $ \cas -> do+      liftIO $ cas @?= []+  testMultiCodeActions testName actionNames start end origin expected =+    helper testName start end origin expected $ \cas -> do+      let r = [ca | (InR ca) <- cas, ca ^. L.title `elem` actionNames]+      liftIO $+        (length r == length actionNames)+          @? "Expected " <> show actionNames <> ", but got " <> show cas <> " which is not its superset"+      forM_ r executeCodeAction+  helper testName (line1, col1) (line2, col2) origin expected k = testSession testName $ do+    void $ createDoc "B.hs" "haskell" $ T.unlines docB+    void $ createDoc "C.hs" "haskell" $ T.unlines docC+    doc <- createDoc "A.hs" "haskell" $ T.unlines (header <> origin)+    void waitForDiagnostics+    waitForProgressDone+    cas <- getCodeActions doc (Range (Position (fromIntegral $ line1 + length header) col1) (Position (fromIntegral $ line2 + length header) col2))+    void $ k [x | x@(InR ca) <- cas, "Hide" `T.isPrefixOf` (ca ^. L.title)]+    contentAfter <- documentContents doc+    liftIO $ contentAfter @?= T.unlines (header <> expected)+  header =+    [ "{-# OPTIONS_GHC -Wname-shadowing #-}"+    , "module A where"+    , ""+    ]+  -- for multi group+  docB =+    [ "module B where"+    , "(++) = id"+    ]+  docC =+    [ "module C where"+    , "(++) = id"+    ]++insertNewDefinitionTests :: TestTree+insertNewDefinitionTests = testGroup "insert new definition actions"+  [ testSession "insert new function definition" $ do+      let txtB =+            ["foo True = select [True]"+            , ""+            ,"foo False = False"+            ]+          txtB' =+            [""+            ,"someOtherCode = ()"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')+      _ <- waitForDiagnostics+      InR action@CodeAction { _title = actionTitle } : _+                  <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>+                     getCodeActions docB (R 0 0 0 50)+      liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool"+      executeCodeAction action+      contentAfterAction <- documentContents docB+      liftIO $ contentAfterAction @?= T.unlines (txtB +++        [ ""+        , "select :: [Bool] -> Bool"+        , "select = _"+        ]+        ++ txtB')+  , testSession "define a hole" $ do+      let txtB =+            ["foo True = _select [True]"+            , ""+            ,"foo False = False"+            ]+          txtB' =+            [""+            ,"someOtherCode = ()"+            ]+      docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')+      _ <- waitForDiagnostics+      InR action@CodeAction { _title = actionTitle } : _+                  <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>+                     getCodeActions docB (R 0 0 0 50)+      liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool"+      executeCodeAction action+      contentAfterAction <- documentContents docB+      liftIO $ contentAfterAction @?= T.unlines (+        ["foo True = select [True]"+        , ""+        ,"foo False = False"+        , ""+        , "select :: [Bool] -> Bool"+        , "select = _"+        ]+        ++ txtB')+  , testSession "insert new function definition - Haddock comments" $ do+    let start =  ["foo :: Int -> Bool"+                 , "foo x = select (x + 1)"+                 , ""+                 , "-- | This is a haddock comment"+                 , "haddock :: Int -> Int"+                 , "haddock = undefined"+                 ]+    let expected =  ["foo :: Int -> Bool"+             , "foo x = select (x + 1)"+             , ""+             , "select :: Int -> Bool"+             , "select = _"+             , ""+             , "-- | This is a haddock comment"+             , "haddock :: Int -> Int"+             , "haddock = undefined"]+    docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start)+    _ <- waitForDiagnostics+    InR action@CodeAction { _title = actionTitle } : _+                <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>+                    getCodeActions docB (R 1 0 0 50)+    liftIO $ actionTitle @?= "Define select :: Int -> Bool"+    executeCodeAction action+    contentAfterAction <- documentContents docB+    liftIO $ contentAfterAction @?= T.unlines expected+  , testSession "insert new function definition - normal comments" $ do+    let start =  ["foo :: Int -> Bool"+                 , "foo x = select (x + 1)"+                 , ""+                 , "-- This is a normal comment"+                 , "normal :: Int -> Int"+                 , "normal = undefined"+                 ]+    let expected =  ["foo :: Int -> Bool"+             , "foo x = select (x + 1)"+             , ""+             , "select :: Int -> Bool"+             , "select = _"+             , ""+             , "-- This is a normal comment"+             , "normal :: Int -> Int"+             , "normal = undefined"]+    docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start)+    _ <- waitForDiagnostics+    InR action@CodeAction { _title = actionTitle } : _+                <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>+                    getCodeActions docB (R 1 0 0 50)+    liftIO $ actionTitle @?= "Define select :: Int -> Bool"+    executeCodeAction action+    contentAfterAction <- documentContents docB+    liftIO $ contentAfterAction @?= T.unlines expected+  ]+++deleteUnusedDefinitionTests :: TestTree+deleteUnusedDefinitionTests = testGroup "delete unused definition action"+  [ testSession "delete unused top level binding" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+               , "module A (some) where"+               , ""+               , "f :: Int -> Int"+               , "f 1 = let a = 1"+               , "      in a"+               , "f 2 = 2"+               , ""+               , "some = ()"+               ])+    (4, 0)+    "Delete ‘f’"+    (T.unlines [+        "{-# OPTIONS_GHC -Wunused-top-binds #-}"+        , "module A (some) where"+        , ""+        , "some = ()"+        ])++  , testSession "delete unused top level binding defined in infix form" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+               , "module A (some) where"+               , ""+               , "myPlus :: Int -> Int -> Int"+               , "a `myPlus` b = a + b"+               , ""+               , "some = ()"+               ])+    (4, 2)+    "Delete ‘myPlus’"+    (T.unlines [+        "{-# OPTIONS_GHC -Wunused-top-binds #-}"+        , "module A (some) where"+        , ""+        , "some = ()"+      ])+  , testSession "delete unused binding in where clause" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (h, g) where"+               , ""+               , "h :: Int"+               , "h = 3"+               , ""+               , "g :: Int"+               , "g = 6"+               , "  where"+               , "    h :: Int"+               , "    h = 4"+               , ""+               ])+    (10, 4)+    "Delete ‘h’"+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (h, g) where"+               , ""+               , "h :: Int"+               , "h = 3"+               , ""+               , "g :: Int"+               , "g = 6"+               , "  where"+               , ""+               ])+  , testSession "delete unused binding with multi-oneline signatures front" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (b, c) where"+               , ""+               , "a, b, c :: Int"+               , "a = 3"+               , "b = 4"+               , "c = 5"+               ])+    (4, 0)+    "Delete ‘a’"+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (b, c) where"+               , ""+               , "b, c :: Int"+               , "b = 4"+               , "c = 5"+               ])+  , testSession "delete unused binding with multi-oneline signatures mid" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (a, c) where"+               , ""+               , "a, b, c :: Int"+               , "a = 3"+               , "b = 4"+               , "c = 5"+               ])+    (5, 0)+    "Delete ‘b’"+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (a, c) where"+               , ""+               , "a, c :: Int"+               , "a = 3"+               , "c = 5"+               ])+  , testSession "delete unused binding with multi-oneline signatures end" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (a, b) where"+               , ""+               , "a, b, c :: Int"+               , "a = 3"+               , "b = 4"+               , "c = 5"+               ])+    (6, 0)+    "Delete ‘c’"+    (T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}"+               , "module A (a, b) where"+               , ""+               , "a, b :: Int"+               , "a = 3"+               , "b = 4"+               ])+  ]+  where+    testFor source pos expectedTitle expectedResult = do+      docId <- createDoc "A.hs" "haskell" source+      expectDiagnostics [ ("A.hs", [(DsWarning, pos, "not used")]) ]++      (action, title) <- extractCodeAction docId "Delete" pos++      liftIO $ title @?= expectedTitle+      executeCodeAction action+      contentAfterAction <- documentContents docId+      liftIO $ contentAfterAction @?= expectedResult++    extractCodeAction docId actionPrefix (l, c) = do+      [action@CodeAction { _title = actionTitle }]  <- findCodeActionsByPrefix docId (R l c l c) [actionPrefix]+      return (action, actionTitle)++addTypeAnnotationsToLiteralsTest :: TestTree+addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals to satisfy constraints"+  [+    testSession "add default type to satisfy one constraint" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "module A (f) where"+               , ""+               , "f = 1"+               ])+    [ (DsWarning, (3, 4), "Defaulting the following constraint") ]+    "Add type annotation ‘Integer’ to ‘1’"+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "module A (f) where"+               , ""+               , "f = (1 :: Integer)"+               ])++  , testSession "add default type to satisfy one constraint in nested expressions" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "module A where"+               , ""+               , "f ="+               , "    let x = 3"+               , "    in x"+               ])+    [ (DsWarning, (4, 12), "Defaulting the following constraint") ]+    "Add type annotation ‘Integer’ to ‘3’"+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "module A where"+               , ""+               , "f ="+               , "    let x = (3 :: Integer)"+               , "    in x"+               ])+  , testSession "add default type to satisfy one constraint in more nested expressions" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "module A where"+               , ""+               , "f ="+               , "    let x = let y = 5 in y"+               , "    in x"+               ])+    [ (DsWarning, (4, 20), "Defaulting the following constraint") ]+    "Add type annotation ‘Integer’ to ‘5’"+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "module A where"+               , ""+               , "f ="+               , "    let x = let y = (5 :: Integer) in y"+               , "    in x"+               ])+  , testSession "add default type to satisfy one constraint with duplicate literals" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "{-# LANGUAGE OverloadedStrings #-}"+               , "module A (f) where"+               , ""+               , "import Debug.Trace"+               , ""+               , "f = seq \"debug\" traceShow \"debug\""+               ])+    [ (DsWarning, (6, 8), "Defaulting the following constraint")+    , (DsWarning, (6, 16), "Defaulting the following constraint")+    ]+    ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "{-# LANGUAGE OverloadedStrings #-}"+               , "module A (f) where"+               , ""+               , "import Debug.Trace"+               , ""+               , "f = seq (\"debug\" :: " <> listOfChar <> ") traceShow \"debug\""+               ])+  , knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $+    testSession "add default type to satisfy two constraints" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "{-# LANGUAGE OverloadedStrings #-}"+               , "module A (f) where"+               , ""+               , "import Debug.Trace"+               , ""+               , "f a = traceShow \"debug\" a"+               ])+    [ (DsWarning, (6, 6), "Defaulting the following constraint") ]+    ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "{-# LANGUAGE OverloadedStrings #-}"+               , "module A (f) where"+               , ""+               , "import Debug.Trace"+               , ""+               , "f a = traceShow (\"debug\" :: " <> listOfChar <> ") a"+               ])+  , knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $+    testSession "add default type to satisfy two constraints with duplicate literals" $+    testFor+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "{-# LANGUAGE OverloadedStrings #-}"+               , "module A (f) where"+               , ""+               , "import Debug.Trace"+               , ""+               , "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow \"debug\"))"+               ])+    [ (DsWarning, (6, 54), "Defaulting the following constraint") ]+    ("Add type annotation ‘" <> listOfChar <> "’ to ‘\"debug\"’")+    (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}"+               , "{-# LANGUAGE OverloadedStrings #-}"+               , "module A (f) where"+               , ""+               , "import Debug.Trace"+               , ""+               , "f = seq (\"debug\" :: [Char]) (seq (\"debug\" :: [Char]) (traceShow (\"debug\" :: " <> listOfChar <> ")))"+               ])+  ]+  where+    testFor source diag expectedTitle expectedResult = do+      docId <- createDoc "A.hs" "haskell" source+      expectDiagnostics [ ("A.hs", diag) ]++      let cursors = map snd3 diag+      (action, title) <- extractCodeAction docId "Add type annotation" (minimum cursors) (maximum cursors)++      liftIO $ title @?= expectedTitle+      executeCodeAction action+      contentAfterAction <- documentContents docId+      liftIO $ contentAfterAction @?= expectedResult++    extractCodeAction docId actionPrefix (l,c) (l', c')= do+      [action@CodeAction { _title = actionTitle }]  <- findCodeActionsByPrefix docId (R l c l' c') [actionPrefix]+      return (action, actionTitle)+++fixConstructorImportTests :: TestTree+fixConstructorImportTests = testGroup "fix import actions"+  [ testSession "fix constructor import" $ template+      (T.unlines+            [ "module ModuleA where"+            , "data A = Constructor"+            ])+      (T.unlines+            [ "module ModuleB where"+            , "import ModuleA(Constructor)"+            ])+      (Range (Position 1 10) (Position 1 11))+      "Fix import of A(Constructor)"+      (T.unlines+            [ "module ModuleB where"+            , "import ModuleA(A(Constructor))"+            ])+  ]+  where+    template contentA contentB range expectedAction expectedContentB = do+      _docA <- createDoc "ModuleA.hs" "haskell" contentA+      docB  <- createDoc "ModuleB.hs" "haskell" contentB+      _diags <- waitForDiagnostics+      InR action@CodeAction { _title = actionTitle } : _+                  <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>+                     getCodeActions docB range+      liftIO $ expectedAction @=? actionTitle+      executeCodeAction action+      contentAfterAction <- documentContents docB+      liftIO $ expectedContentB @=? contentAfterAction++importRenameActionTests :: TestTree+importRenameActionTests = testGroup "import rename actions"+  [ testSession "Data.Mape -> Data.Map"   $ check "Map"+  , testSession "Data.Mape -> Data.Maybe" $ check "Maybe" ] where+  check modname = do+      let content = T.unlines+            [ "module Testing where"+            , "import Data.Mape"+            ]+      doc <- createDoc "Testing.hs" "haskell" content+      _ <- waitForDiagnostics+      actionsOrCommands <- getCodeActions doc (Range (Position 1 8) (Position 1 16))+      let [changeToMap] = [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, ("Data." <> modname) `T.isInfixOf` actionTitle ]+      executeCodeAction changeToMap+      contentAfterAction <- documentContents doc+      let expectedContentAfterAction = T.unlines+            [ "module Testing where"+            , "import Data." <> modname+            ]+      liftIO $ expectedContentAfterAction @=? contentAfterAction++fillTypedHoleTests :: TestTree+fillTypedHoleTests = let++  sourceCode :: T.Text -> T.Text -> T.Text -> T.Text+  sourceCode a b c = T.unlines+    [ "module Testing where"+      , ""+      , "globalConvert :: Int -> String"+      , "globalConvert = undefined"+      , ""+      , "globalInt :: Int"+      , "globalInt = 3"+      , ""+      , "bar :: Int -> Int -> String"+      , "bar n parameterInt = " <> a <> " (n + " <> b <> " + " <> c <> ")  where"+      , "  localConvert = (flip replicate) 'x'"+      , ""+      , "foo :: () -> Int -> String"+      , "foo = undefined"++    ]++  check :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> TestTree+  check actionTitle+        oldA oldB oldC+        newA newB newC = testSession (T.unpack actionTitle) $ do+    let originalCode = sourceCode oldA oldB oldC+    let expectedCode = sourceCode newA newB newC+    doc <- createDoc "Testing.hs" "haskell" originalCode+    _ <- waitForDiagnostics+    actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))+    chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands+    executeCodeAction chosenAction+    modifiedCode <- documentContents doc+    liftIO $ expectedCode @=? modifiedCode+  in+  testGroup "fill typed holes"+  [ check "replace _ with show"+          "_"    "n" "n"+          "show" "n" "n"++  , check "replace _ with globalConvert"+          "_"             "n" "n"+          "globalConvert" "n" "n"++  , check "replace _convertme with localConvert"+          "_convertme"   "n" "n"+          "localConvert" "n" "n"++  , check "replace _b with globalInt"+          "_a" "_b"        "_c"+          "_a" "globalInt" "_c"++  , check "replace _c with globalInt"+          "_a" "_b"        "_c"+          "_a" "_b" "globalInt"++  , check "replace _c with parameterInt"+          "_a" "_b" "_c"+          "_a" "_b"  "parameterInt"+  , check "replace _ with foo _"+          "_" "n" "n"+          "(foo _)" "n" "n"+  , testSession "replace _toException with E.toException" $ do+      let mkDoc x = T.unlines+            [ "module Testing where"+            , "import qualified Control.Exception as E"+            , "ioToSome :: E.IOException -> E.SomeException"+            , "ioToSome = " <> x ]+      doc <- createDoc "Test.hs" "haskell" $ mkDoc "_toException"+      _ <- waitForDiagnostics+      actions <- getCodeActions doc (Range (Position 3 0) (Position 3 maxBound))+      chosen <- liftIO $ pickActionWithTitle "replace _toException with E.toException" actions+      executeCodeAction chosen+      modifiedCode <- documentContents doc+      liftIO $ mkDoc "E.toException" @=? modifiedCode+  , testSession "filling infix type hole uses prefix notation" $ do+      let mkDoc x = T.unlines+              [ "module Testing where"+              , "data A = A"+              , "foo :: A -> A -> A"+              , "foo A A = A"+              , "test :: A -> A -> A"+              , "test a1 a2 = a1 " <> x <> " a2"+              ]+      doc <- createDoc "Test.hs" "haskell" $ mkDoc "`_`"+      _ <- waitForDiagnostics+      actions <- getCodeActions doc (Range (Position 5 16) (Position 5 19))+      chosen <- liftIO $ pickActionWithTitle "replace _ with foo" actions+      executeCodeAction chosen+      modifiedCode <- documentContents doc+      liftIO $ mkDoc "`foo`" @=? modifiedCode+  , testSession "postfix hole uses postfix notation of infix operator" $ do+      let mkDoc x = T.unlines+              [ "module Testing where"+              , "test :: Int -> Int -> Int"+              , "test a1 a2 = " <> x <> " a1 a2"+              ]+      doc <- createDoc "Test.hs" "haskell" $ mkDoc "_"+      _ <- waitForDiagnostics+      actions <- getCodeActions doc (Range (Position 2 13) (Position 2 14))+      chosen <- liftIO $ pickActionWithTitle "replace _ with (+)" actions+      executeCodeAction chosen+      modifiedCode <- documentContents doc+      liftIO $ mkDoc "(+)" @=? modifiedCode+  , testSession "filling infix type hole uses infix operator" $ do+      let mkDoc x = T.unlines+              [ "module Testing where"+              , "test :: Int -> Int -> Int"+              , "test a1 a2 = a1 " <> x <> " a2"+              ]+      doc <- createDoc "Test.hs" "haskell" $ mkDoc "`_`"+      _ <- waitForDiagnostics+      actions <- getCodeActions doc (Range (Position 2 16) (Position 2 19))+      chosen <- liftIO $ pickActionWithTitle "replace _ with (+)" actions+      executeCodeAction chosen+      modifiedCode <- documentContents doc+      liftIO $ mkDoc "+" @=? modifiedCode+  ]++addInstanceConstraintTests :: TestTree+addInstanceConstraintTests = let+  missingConstraintSourceCode :: Maybe T.Text -> T.Text+  missingConstraintSourceCode mConstraint =+    let constraint = maybe "" (<> " => ") mConstraint+     in T.unlines+    [ "module Testing where"+    , ""+    , "data Wrap a = Wrap a"+    , ""+    , "instance " <> constraint <> "Eq (Wrap a) where"+    , "  (Wrap x) == (Wrap y) = x == y"+    ]++  incompleteConstraintSourceCode :: Maybe T.Text -> T.Text+  incompleteConstraintSourceCode mConstraint =+    let constraint = maybe "Eq a" (\c -> "(Eq a, " <> c <> ")")  mConstraint+     in T.unlines+    [ "module Testing where"+    , ""+    , "data Pair a b = Pair a b"+    , ""+    , "instance " <> constraint <> " => Eq (Pair a b) where"+    , "  (Pair x y) == (Pair x' y') = x == x' && y == y'"+    ]++  incompleteConstraintSourceCode2 :: Maybe T.Text -> T.Text+  incompleteConstraintSourceCode2 mConstraint =+    let constraint = maybe "(Eq a, Eq b)" (\c -> "(Eq a, Eq b, " <> c <> ")")  mConstraint+     in T.unlines+    [ "module Testing where"+    , ""+    , "data Three a b c = Three a b c"+    , ""+    , "instance " <> constraint <> " => Eq (Three a b c) where"+    , "  (Three x y z) == (Three x' y' z') = x == x' && y == y' && z == z'"+    ]++  check :: T.Text -> T.Text -> T.Text -> TestTree+  check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do+    doc <- createDoc "Testing.hs" "haskell" originalCode+    _ <- waitForDiagnostics+    actionsOrCommands <- getAllCodeActions doc+    chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands+    executeCodeAction chosenAction+    modifiedCode <- documentContents doc+    liftIO $ expectedCode @=? modifiedCode++  in testGroup "add instance constraint"+  [ check+    "Add `Eq a` to the context of the instance declaration"+    (missingConstraintSourceCode Nothing)+    (missingConstraintSourceCode $ Just "Eq a")+  , check+    "Add `Eq b` to the context of the instance declaration"+    (incompleteConstraintSourceCode Nothing)+    (incompleteConstraintSourceCode $ Just "Eq b")+  , check+    "Add `Eq c` to the context of the instance declaration"+    (incompleteConstraintSourceCode2 Nothing)+    (incompleteConstraintSourceCode2 $ Just "Eq c")+  ]++addFunctionConstraintTests :: TestTree+addFunctionConstraintTests = let+  missingConstraintSourceCode :: T.Text -> T.Text+  missingConstraintSourceCode constraint =+    T.unlines+    [ "module Testing where"+    , ""+    , "eq :: " <> constraint <> "a -> a -> Bool"+    , "eq x y = x == y"+    ]++  missingConstraintWithForAllSourceCode :: T.Text -> T.Text+  missingConstraintWithForAllSourceCode constraint =+    T.unlines+    [ "{-# LANGUAGE ExplicitForAll #-}"+    , "module Testing where"+    , ""+    , "eq :: forall a. " <> constraint <> "a -> a -> Bool"+    , "eq x y = x == y"+    ]++  incompleteConstraintWithForAllSourceCode :: T.Text -> T.Text+  incompleteConstraintWithForAllSourceCode constraint =+    T.unlines+    [ "{-# LANGUAGE ExplicitForAll #-}"+    , "module Testing where"+    , ""+    , "data Pair a b = Pair a b"+    , ""+    , "eq :: " <> constraint <> " => Pair a b -> Pair a b -> Bool"+    , "eq (Pair x y) (Pair x' y') = x == x' && y == y'"+    ]++  incompleteConstraintSourceCode :: T.Text -> T.Text+  incompleteConstraintSourceCode constraint =+    T.unlines+    [ "module Testing where"+    , ""+    , "data Pair a b = Pair a b"+    , ""+    , "eq :: " <> constraint <> " => Pair a b -> Pair a b -> Bool"+    , "eq (Pair x y) (Pair x' y') = x == x' && y == y'"+    ]++  incompleteConstraintSourceCode2 :: T.Text -> T.Text+  incompleteConstraintSourceCode2 constraint =+    T.unlines+    [ "module Testing where"+    , ""+    , "data Three a b c = Three a b c"+    , ""+    , "eq :: " <> constraint <> " => Three a b c -> Three a b c -> Bool"+    , "eq (Three x y z) (Three x' y' z') = x == x' && y == y' && z == z'"+    ]++  incompleteConstraintSourceCodeWithExtraCharsInContext :: T.Text -> T.Text+  incompleteConstraintSourceCodeWithExtraCharsInContext constraint =+    T.unlines+    [ "module Testing where"+    , ""+    , "data Pair a b = Pair a b"+    , ""+    , "eq :: ( " <> constraint <> " ) => Pair a b -> Pair a b -> Bool"+    , "eq (Pair x y) (Pair x' y') = x == x' && y == y'"+    ]++  incompleteConstraintSourceCodeWithNewlinesInTypeSignature :: T.Text -> T.Text+  incompleteConstraintSourceCodeWithNewlinesInTypeSignature constraint =+    T.unlines+    [ "module Testing where"+    , "data Pair a b = Pair a b"+    , "eq "+    , "    :: (" <> constraint <> ")"+    , "    => Pair a b -> Pair a b -> Bool"+    , "eq (Pair x y) (Pair x' y') = x == x' && y == y'"+    ]++  missingMonadConstraint constraint = T.unlines+    [ "module Testing where"+    , "f :: " <> constraint <> "m ()"+    , "f = do "+    , "  return ()"+    ]++  in testGroup "add function constraint"+  [ checkCodeAction+    "no preexisting constraint"+    "Add `Eq a` to the context of the type signature for `eq`"+    (missingConstraintSourceCode "")+    (missingConstraintSourceCode "Eq a => ")+  , checkCodeAction+    "no preexisting constraint, with forall"+    "Add `Eq a` to the context of the type signature for `eq`"+    (missingConstraintWithForAllSourceCode "")+    (missingConstraintWithForAllSourceCode "Eq a => ")+  , checkCodeAction+    "preexisting constraint, no parenthesis"+    "Add `Eq b` to the context of the type signature for `eq`"+    (incompleteConstraintSourceCode "Eq a")+    (incompleteConstraintSourceCode "(Eq a, Eq b)")+  , checkCodeAction+    "preexisting constraints in parenthesis"+    "Add `Eq c` to the context of the type signature for `eq`"+    (incompleteConstraintSourceCode2 "(Eq a, Eq b)")+    (incompleteConstraintSourceCode2 "(Eq a, Eq b, Eq c)")+  , checkCodeAction+    "preexisting constraints with forall"+    "Add `Eq b` to the context of the type signature for `eq`"+    (incompleteConstraintWithForAllSourceCode "Eq a")+    (incompleteConstraintWithForAllSourceCode "(Eq a, Eq b)")+  , checkCodeAction+    "preexisting constraint, with extra spaces in context"+    "Add `Eq b` to the context of the type signature for `eq`"+    (incompleteConstraintSourceCodeWithExtraCharsInContext "Eq a")+    (incompleteConstraintSourceCodeWithExtraCharsInContext "Eq a, Eq b")+  , checkCodeAction+    "preexisting constraint, with newlines in type signature"+    "Add `Eq b` to the context of the type signature for `eq`"+    (incompleteConstraintSourceCodeWithNewlinesInTypeSignature "Eq a")+    (incompleteConstraintSourceCodeWithNewlinesInTypeSignature "Eq a, Eq b")+  , checkCodeAction+    "missing Monad constraint"+    "Add `Monad m` to the context of the type signature for `f`"+    (missingMonadConstraint "")+    (missingMonadConstraint "Monad m => ")+  ]++checkCodeAction :: String -> T.Text -> T.Text -> T.Text -> TestTree+checkCodeAction testName actionTitle originalCode expectedCode = testSession testName $ do+  doc <- createDoc "Testing.hs" "haskell" originalCode+  _ <- waitForDiagnostics+  actionsOrCommands <- getAllCodeActions doc+  chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands+  executeCodeAction chosenAction+  modifiedCode <- documentContents doc+  liftIO $ expectedCode @=? modifiedCode++addImplicitParamsConstraintTests :: TestTree+addImplicitParamsConstraintTests =+  testGroup+    "add missing implicit params constraints"+    [ testGroup+        "introduced"+        [ let ex ctxtA = exampleCode "?a" ctxtA ""+           in checkCodeAction "at top level" "Add ?a::() to the context of fBase" (ex "") (ex "?a::()"),+          let ex ctxA = exampleCode "x where x = ?a" ctxA ""+           in checkCodeAction "in nested def" "Add ?a::() to the context of fBase" (ex "") (ex "?a::()")+        ],+      testGroup+        "inherited"+        [ let ex = exampleCode "()" "?a::()"+           in checkCodeAction+                "with preexisting context"+                "Add `?a::()` to the context of the type signature for `fCaller`"+                (ex "Eq ()")+                (ex "Eq (), ?a::()"),+          let ex = exampleCode "()" "?a::()"+           in checkCodeAction "without preexisting context" "Add ?a::() to the context of fCaller" (ex "") (ex "?a::()")+        ]+    ]+  where+    mkContext ""       = ""+    mkContext contents = "(" <> contents <> ") => "++    exampleCode bodyBase contextBase contextCaller =+      T.unlines+        [ "{-# LANGUAGE FlexibleContexts, ImplicitParams #-}",+          "module Testing where",+          "fBase :: " <> mkContext contextBase <> "()",+          "fBase = " <> bodyBase,+          "fCaller :: " <> mkContext contextCaller <> "()",+          "fCaller = fBase"+        ]++removeRedundantConstraintsTests :: TestTree+removeRedundantConstraintsTests = let+  header =+    [ "{-# OPTIONS_GHC -Wredundant-constraints #-}"+    , "module Testing where"+    , ""+    ]++  headerExt :: [T.Text] -> [T.Text]+  headerExt exts =+    redunt : extTxt ++ ["module Testing where"]+    where+      redunt = "{-# OPTIONS_GHC -Wredundant-constraints #-}"+      extTxt = map (\ext -> "{-# LANGUAGE " <> ext <> " #-}") exts++  redundantConstraintsCode :: Maybe T.Text -> T.Text+  redundantConstraintsCode mConstraint =+    let constraint = maybe "" (\c -> "" <> c <> " => ") mConstraint+      in T.unlines $ header <>+        [ "foo :: " <> constraint <> "a -> a"+        , "foo = id"+        ]++  redundantMixedConstraintsCode :: Maybe T.Text -> T.Text+  redundantMixedConstraintsCode mConstraint =+    let constraint = maybe "(Num a, Eq a)" (\c -> "(Num a, Eq a, " <> c <> ")") mConstraint+      in T.unlines $ header <>+        [ "foo :: " <> constraint <> " => a -> Bool"+        , "foo x = x == 1"+        ]++  typeSignatureSpaces :: Maybe T.Text -> T.Text+  typeSignatureSpaces mConstraint =+    let constraint = maybe "(Num a, Eq a)" (\c -> "(Num a, Eq a, " <> c <> ")") mConstraint+      in T.unlines $ header <>+        [ "foo ::  " <> constraint <> " => a -> Bool"+        , "foo x = x == 1"+        ]++  redundantConstraintsForall :: Maybe T.Text -> T.Text+  redundantConstraintsForall mConstraint =+    let constraint = maybe "" (\c -> "" <> c <> " => ") mConstraint+      in T.unlines $ headerExt ["RankNTypes"] <>+        [ "foo :: forall a. " <> constraint <> "a -> a"+        , "foo = id"+        ]++  typeSignatureDo :: Maybe T.Text -> T.Text+  typeSignatureDo mConstraint =+    let constraint = maybe "" (\c -> "" <> c <> " => ") mConstraint+      in T.unlines $ header <>+        [ "f :: Int -> IO ()"+        , "f n = do"+        , "  let foo :: " <> constraint <> "a -> IO ()"+        , "      foo _ = return ()"+        , "  r n"+        ]++  typeSignatureNested :: Maybe T.Text -> T.Text+  typeSignatureNested mConstraint =+    let constraint = maybe "" (\c -> "" <> c <> " => ") mConstraint+      in T.unlines $ header <>+        [ "f :: Int -> ()"+        , "f = g"+        , "  where"+        , "    g :: " <> constraint <> "a -> ()"+        , "    g _ = ()"+        ]++  typeSignatureNested' :: Maybe T.Text -> T.Text+  typeSignatureNested' mConstraint =+    let constraint = maybe "" (\c -> "" <> c <> " => ") mConstraint+      in T.unlines $ header <>+        [ "f :: Int -> ()"+        , "f ="+        , "  let"+        , "    g :: Int -> ()"+        , "    g = h"+        , "      where"+        , "        h :: " <> constraint <> "a -> ()"+        , "        h _ = ()"+        , "  in g"+        ]++  typeSignatureNested'' :: Maybe T.Text -> T.Text+  typeSignatureNested'' mConstraint =+    let constraint = maybe "" (\c -> "" <> c <> " => ") mConstraint+      in T.unlines $ header <>+        [ "f :: Int -> ()"+        , "f = g"+        , "  where"+        , "    g :: Int -> ()"+        , "    g = "+        , "      let"+        , "        h :: " <> constraint <> "a -> ()"+        , "        h _ = ()"+        , "      in h"+        ]++  typeSignatureLined1 = T.unlines $ header <>+    [ "foo :: Eq a =>"+    , "  a -> Bool"+    , "foo _ = True"+    ]++  typeSignatureLined2 = T.unlines $ header <>+    [ "foo :: (Eq a, Show a)"+    , "  => a -> Bool"+    , "foo _ = True"+    ]++  typeSignatureOneLine = T.unlines $ header <>+    [ "foo :: a -> Bool"+    , "foo _ = True"+    ]++  typeSignatureLined3 = T.unlines $ header <>+    [ "foo :: ( Eq a"+    , "       , Show a"+    , "       )"+    , "    => a -> Bool"+    , "foo x = x == x"+    ]++  typeSignatureLined3' = T.unlines $ header <>+    [ "foo :: ( Eq a"+    , "       )"+    , "    => a -> Bool"+    , "foo x = x == x"+    ]+++  check :: T.Text -> T.Text -> T.Text -> TestTree+  check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do+    doc <- createDoc "Testing.hs" "haskell" originalCode+    _ <- waitForDiagnostics+    actionsOrCommands <- getAllCodeActions doc+    chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands+    executeCodeAction chosenAction+    modifiedCode <- documentContents doc+    liftIO $ expectedCode @=? modifiedCode++  in testGroup "remove redundant function constraints"+  [ check+    "Remove redundant constraint `Eq a` from the context of the type signature for `foo`"+    (redundantConstraintsCode $ Just "Eq a")+    (redundantConstraintsCode Nothing)+  , check+    "Remove redundant constraints `(Eq a, Monoid a)` from the context of the type signature for `foo`"+    (redundantConstraintsCode $ Just "(Eq a, Monoid a)")+    (redundantConstraintsCode Nothing)+  , check+    "Remove redundant constraints `(Monoid a, Show a)` from the context of the type signature for `foo`"+    (redundantMixedConstraintsCode $ Just "Monoid a, Show a")+    (redundantMixedConstraintsCode Nothing)+  , check+    "Remove redundant constraint `Eq a` from the context of the type signature for `g`"+    (typeSignatureNested $ Just "Eq a")+    (typeSignatureNested Nothing)+  , check+    "Remove redundant constraint `Eq a` from the context of the type signature for `h`"+    (typeSignatureNested' $ Just "Eq a")+    (typeSignatureNested' Nothing)+  , check+    "Remove redundant constraint `Eq a` from the context of the type signature for `h`"+    (typeSignatureNested'' $ Just "Eq a")+    (typeSignatureNested'' Nothing)+  , check+    "Remove redundant constraint `Eq a` from the context of the type signature for `foo`"+    (redundantConstraintsForall $ Just "Eq a")+    (redundantConstraintsForall Nothing)+  , check+    "Remove redundant constraint `Eq a` from the context of the type signature for `foo`"+    (typeSignatureDo $ Just "Eq a")+    (typeSignatureDo Nothing)+  , check+    "Remove redundant constraints `(Monoid a, Show a)` from the context of the type signature for `foo`"+    (typeSignatureSpaces $ Just "Monoid a, Show a")+    (typeSignatureSpaces Nothing)+    , check+    "Remove redundant constraint `Eq a` from the context of the type signature for `foo`"+    typeSignatureLined1+    typeSignatureOneLine+    , check+    "Remove redundant constraints `(Eq a, Show a)` from the context of the type signature for `foo`"+    typeSignatureLined2+    typeSignatureOneLine+    , check+    "Remove redundant constraint `Show a` from the context of the type signature for `foo`"+    typeSignatureLined3+    typeSignatureLined3'+  ]++addSigActionTests :: TestTree+addSigActionTests = let+  header = [ "{-# OPTIONS_GHC -Wmissing-signatures -Wmissing-pattern-synonym-signatures #-}"+           , "{-# LANGUAGE PatternSynonyms,BangPatterns,GADTs #-}"+           , "module Sigs where"+           , "data T1 a where"+           , "  MkT1 :: (Show b) => a -> b -> T1 a"+           ]+  before def     = T.unlines $ header ++ [def]+  after' def sig = T.unlines $ header ++ [sig, def]++  def >:: sig = testSession (T.unpack $ T.replace "\n" "\\n" def) $ do+    let originalCode = before def+    let expectedCode = after' def sig+    doc <- createDoc "Sigs.hs" "haskell" originalCode+    _ <- waitForDiagnostics+    actionsOrCommands <- getCodeActions doc (Range (Position 5 1) (Position 5 maxBound))+    chosenAction <- liftIO $ pickActionWithTitle ("add signature: " <> sig) actionsOrCommands+    executeCodeAction chosenAction+    modifiedCode <- documentContents doc+    liftIO $ expectedCode @=? modifiedCode+  in+  testGroup "add signature"+    [ "abc = True"              >:: "abc :: Bool"+    , "foo a b = a + b"         >:: "foo :: Num a => a -> a -> a"+    , "bar a b = show $ a + b"  >:: "bar :: (Show a, Num a) => a -> a -> String"+    , "(!!!) a b = a > b"       >:: "(!!!) :: Ord a => a -> a -> Bool"+    , "a >>>> b = a + b"        >:: "(>>>>) :: Num a => a -> a -> a"+    , "a `haha` b = a b"        >:: "haha :: (t1 -> t2) -> t1 -> t2"+    , "pattern Some a = Just a" >:: "pattern Some :: a -> Maybe a"+    , "pattern Some a <- Just a" >:: "pattern Some :: a -> Maybe a"+    , "pattern Some a <- Just a\n  where Some a = Just a" >:: "pattern Some :: a -> Maybe a"+    , "pattern Some a <- Just !a\n  where Some !a = Just a" >:: "pattern Some :: a -> Maybe a"+    , "pattern Point{x, y} = (x, y)" >:: "pattern Point :: a -> b -> (a, b)"+    , "pattern Point{x, y} <- (x, y)" >:: "pattern Point :: a -> b -> (a, b)"+    , "pattern Point{x, y} <- (x, y)\n  where Point x y = (x, y)" >:: "pattern Point :: a -> b -> (a, b)"+    , "pattern MkT1' b = MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"+    , "pattern MkT1' b <- MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"+    , "pattern MkT1' b <- MkT1 42 b\n  where MkT1' b = MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"+    ]++exportUnusedTests :: TestTree+exportUnusedTests = testGroup "export unused actions"+  [ testGroup "don't want suggestion"+    [ testSession "implicit exports" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# OPTIONS_GHC -Wmissing-signatures #-}"+              , "module A where"+              , "foo = id"])+        (R 3 0 3 3)+        "Export ‘foo’"+        Nothing -- codeaction should not be available+    , testSession "not top-level" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# OPTIONS_GHC -Wunused-binds #-}"+              , "module A (foo,bar) where"+              , "foo = ()"+              , "  where bar = ()"+              , "bar = ()"])+        (R 2 0 2 11)+        "Export ‘bar’"+        Nothing+    , ignoreForGHC92 "Diagnostic message has no suggestions" $+      testSession "type is exported but not the constructor of same name" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (Foo) where"+              , "data Foo = Foo"])+        (R 2 0 2 8)+        "Export ‘Foo’"+        Nothing -- codeaction should not be available+    , testSession "unused data field" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (Foo(Foo)) where"+              , "data Foo = Foo {foo :: ()}"])+        (R 2 0 2 20)+        "Export ‘foo’"+        Nothing -- codeaction should not be available+    ]+  , testGroup "want suggestion"+    [ testSession "empty exports" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A ("+              , ") where"+              , "foo = id"])+        (R 3 0 3 3)+        "Export ‘foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A ("+              , "foo) where"+              , "foo = id"])+    , testSession "single line explicit exports" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (foo) where"+              , "foo = id"+              , "bar = foo"])+        (R 3 0 3 3)+        "Export ‘bar’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (foo, bar) where"+              , "foo = id"+              , "bar = foo"])+    , testSession "multi line explicit exports" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ("+              , "    foo) where"+              , "foo = id"+              , "bar = foo"])+        (R 5 0 5 3)+        "Export ‘bar’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ("+              , "    foo, bar) where"+              , "foo = id"+              , "bar = foo"])+    , testSession "export list ends in comma" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  (foo,"+              , "  ) where"+              , "foo = id"+              , "bar = foo"])+        (R 5 0 5 3)+        "Export ‘bar’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  (foo,"+              , "  bar) where"+              , "foo = id"+              , "bar = foo"])+    , testSession "style of multiple exports is preserved 1" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ( foo"+              , "  , bar"+              , "  ) where"+              , "foo = id"+              , "bar = foo"+              , "baz = bar"+              ])+        (R 7 0 7 3)+        "Export ‘baz’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ( foo"+              , "  , bar"+              , "  , baz"+              , "  ) where"+              , "foo = id"+              , "bar = foo"+              , "baz = bar"+              ])+    , testSession "style of multiple exports is preserved 2" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ( foo,"+              , "    bar"+              , "  ) where"+              , "foo = id"+              , "bar = foo"+              , "baz = bar"+              ])+        (R 7 0 7 3)+        "Export ‘baz’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ( foo,"+              , "    bar,"+              , "    baz"+              , "  ) where"+              , "foo = id"+              , "bar = foo"+              , "baz = bar"+              ])+    , testSession "style of multiple exports is preserved and selects smallest export separator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ( foo"+              , "  , bar"+              , "  -- * For testing"+              , "  , baz"+              , "  ) where"+              , "foo = id"+              , "bar = foo"+              , "baz = bar"+              , "quux = bar"+              ])+        (R 10 0 10 4)+        "Export ‘quux’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A"+              , "  ( foo"+              , "  , bar"+              , "  -- * For testing"+              , "  , baz"+              , "  , quux"+              , "  ) where"+              , "foo = id"+              , "bar = foo"+              , "baz = bar"+              , "quux = bar"+              ])+    , testSession "unused pattern synonym" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE PatternSynonyms #-}"+              , "module A () where"+              , "pattern Foo a <- (a, _)"])+        (R 3 0 3 10)+        "Export ‘Foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE PatternSynonyms #-}"+              , "module A (pattern Foo) where"+              , "pattern Foo a <- (a, _)"])+    , testSession "unused data type" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A () where"+              , "data Foo = Foo"])+        (R 2 0 2 7)+        "Export ‘Foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (Foo(..)) where"+              , "data Foo = Foo"])+    , testSession "unused newtype" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A () where"+              , "newtype Foo = Foo ()"])+        (R 2 0 2 10)+        "Export ‘Foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (Foo(..)) where"+              , "newtype Foo = Foo ()"])+    , testSession "unused type synonym" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A () where"+              , "type Foo = ()"])+        (R 2 0 2 7)+        "Export ‘Foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (Foo) where"+              , "type Foo = ()"])+    , testSession "unused type family" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeFamilies #-}"+              , "module A () where"+              , "type family Foo p"])+        (R 3 0 3 15)+        "Export ‘Foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeFamilies #-}"+              , "module A (Foo) where"+              , "type family Foo p"])+    , testSession "unused typeclass" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A () where"+              , "class Foo a"])+        (R 2 0 2 8)+        "Export ‘Foo’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (Foo(..)) where"+              , "class Foo a"])+    , testSession "infix" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A () where"+              , "a `f` b = ()"])+        (R 2 0 2 11)+        "Export ‘f’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A (f) where"+              , "a `f` b = ()"])+    , testSession "function operator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A () where"+              , "(<|) = ($)"])+        (R 2 0 2 9)+        "Export ‘<|’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "module A ((<|)) where"+              , "(<|) = ($)"])+    , testSession "type synonym operator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A () where"+              , "type (:<) = ()"])+        (R 3 0 3 13)+        "Export ‘:<’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A ((:<)) where"+              , "type (:<) = ()"])+    , testSession "type family operator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeFamilies #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A () where"+              , "type family (:<)"])+        (R 4 0 4 15)+        "Export ‘:<’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeFamilies #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A (type (:<)) where"+              , "type family (:<)"])+    , testSession "typeclass operator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A () where"+              , "class (:<) a"])+        (R 3 0 3 11)+        "Export ‘:<’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A (type (:<)(..)) where"+              , "class (:<) a"])+    , testSession "newtype operator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A () where"+              , "newtype (:<) = Foo ()"])+        (R 3 0 3 20)+        "Export ‘:<’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A (type (:<)(..)) where"+              , "newtype (:<) = Foo ()"])+    , testSession "data type operator" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A () where"+              , "data (:<) = Foo ()"])+        (R 3 0 3 17)+        "Export ‘:<’"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"+              , "{-# LANGUAGE TypeOperators #-}"+              , "module A (type (:<)(..)) where"+              , "data (:<) = Foo ()"])+    ]+  ]+  where+    template doc range = exportTemplate (Just range) doc++exportTemplate :: Maybe Range -> T.Text -> T.Text -> Maybe T.Text -> Session ()+exportTemplate mRange initialContent expectedAction expectedContents = do+  doc <- createDoc "A.hs" "haskell" initialContent+  _ <- waitForDiagnostics+  actions <- case mRange of+    Nothing    -> getAllCodeActions doc+    Just range -> getCodeActions doc range+  case expectedContents of+    Just content -> do+      action <- liftIO $ pickActionWithTitle expectedAction actions+      executeCodeAction action+      contentAfterAction <- documentContents doc+      liftIO $ content @=? contentAfterAction+    Nothing ->+      liftIO $ [_title | InR CodeAction{_title} <- actions, _title == expectedAction ] @?= []++removeExportTests :: TestTree+removeExportTests = testGroup "remove export actions"+    [ testSession "single export" $ template+        (T.unlines+              [ "module A (  a   ) where"+              , "b :: ()"+              , "b = ()"])+        "Remove ‘a’ from export"+        (Just $ T.unlines+              [ "module A (     ) where"+              , "b :: ()"+              , "b = ()"])+    , testSession "ending comma" $ template+        (T.unlines+              [ "module A (  a,   ) where"+              , "b :: ()"+              , "b = ()"])+        "Remove ‘a’ from export"+        (Just $ T.unlines+              [ "module A (  ) where"+              , "b :: ()"+              , "b = ()"])+    , testSession "multiple exports" $ template+        (T.unlines+              [ "module A (a  ,   c,    b ) where"+              , "a, c :: ()"+              , "a = ()"+              , "c = ()"])+        "Remove ‘b’ from export"+        (Just $ T.unlines+              [ "module A (a  ,   c ) where"+              , "a, c :: ()"+              , "a = ()"+              , "c = ()"])+    , testSession "not in scope constructor" $ template+        (T.unlines+              [ "module A (A (X,Y,Z,(:<)), ab) where"+              , "data A = X Int | Y | (:<) Int"+              , "ab :: ()"+              , "ab = ()"+              ])+        "Remove ‘Z’ from export"+        (Just $ T.unlines+              [ "module A (A (X,Y,(:<)), ab) where"+              , "data A = X Int | Y | (:<) Int"+              , "ab :: ()"+              , "ab = ()"])+    , testSession "multiline export" $ template+        (T.unlines+              [ "module A (a"+              , " ,  b"+              , " , (:*:)"+              , " , ) where"+              , "a,b :: ()"+              , "a = ()"+              , "b = ()"])+        "Remove ‘:*:’ from export"+        (Just $ T.unlines+              [ "module A (a"+              , " ,  b"+              , " "+              , " , ) where"+              , "a,b :: ()"+              , "a = ()"+              , "b = ()"])+    , testSession "qualified re-export" $ template+        (T.unlines+              [ "module A (M.x,a) where"+              , "import qualified Data.List as M"+              , "a :: ()"+              , "a = ()"])+        "Remove ‘M.x’ from export"+        (Just $ T.unlines+              [ "module A (a) where"+              , "import qualified Data.List as M"+              , "a :: ()"+              , "a = ()"])+    , testSession "qualified re-export ending in '.'" $ template+        (T.unlines+              [ "module A ((M.@.),a) where"+              , "import qualified Data.List as M"+              , "a :: ()"+              , "a = ()"])+        "Remove ‘M.@.’ from export"+        (Just $ T.unlines+              [ "module A (a) where"+              , "import qualified Data.List as M"+              , "a :: ()"+              , "a = ()"])+    , testSession "export module" $ template+        (T.unlines+              [ "module A (module B) where"+              , "a :: ()"+              , "a = ()"])+        "Remove ‘module B’ from export"+        (Just $ T.unlines+              [ "module A () where"+              , "a :: ()"+              , "a = ()"])+    , testSession "dodgy export" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wall #-}"+              , "module A (A (..)) where"+              , "data X = X"+              , "type A = X"])+        "Remove ‘A(..)’ from export"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wall #-}"+              , "module A () where"+              , "data X = X"+              , "type A = X"])+    , testSession "dodgy export" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wall #-}"+              , "module A (A (..)) where"+              , "data X = X"+              , "type A = X"])+        "Remove ‘A(..)’ from export"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wall #-}"+              , "module A () where"+              , "data X = X"+              , "type A = X"])+    , testSession "duplicate module export" $ template+        (T.unlines+              [ "{-# OPTIONS_GHC -Wall #-}"+              , "module A (module L,module L) where"+              , "import Data.List as L"+              , "a :: ()"+              , "a = ()"])+        "Remove ‘Module L’ from export"+        (Just $ T.unlines+              [ "{-# OPTIONS_GHC -Wall #-}"+              , "module A (module L) where"+              , "import Data.List as L"+              , "a :: ()"+              , "a = ()"])+    , testSession "remove all exports single" $ template+        (T.unlines+              [ "module A (x) where"+              , "a :: ()"+              , "a = ()"])+        "Remove all redundant exports"+        (Just $ T.unlines+              [ "module A () where"+              , "a :: ()"+              , "a = ()"])+    , testSession "remove all exports two" $ template+        (T.unlines+              [ "module A (x,y) where"+              , "a :: ()"+              , "a = ()"])+        "Remove all redundant exports"+        (Just $ T.unlines+              [ "module A () where"+              , "a :: ()"+              , "a = ()"])+    , testSession "remove all exports three" $ template+        (T.unlines+              [ "module A (a,x,y) where"+              , "a :: ()"+              , "a = ()"])+        "Remove all redundant exports"+        (Just $ T.unlines+              [ "module A (a) where"+              , "a :: ()"+              , "a = ()"])+    , testSession "remove all exports composite" $ template+        (T.unlines+              [ "module A (x,y,b, module Ls, a, A(X,getW, Y, Z,(:-),getV), (-+), B(B)) where"+              , "data A = X {getV :: Int} | Y {getV :: Int}"+              , "data B = B"+              , "a,b :: ()"+              , "a = ()"+              , "b = ()"])+        "Remove all redundant exports"+        (Just $ T.unlines+              [ "module A (b, a, A(X, Y,getV), B(B)) where"+              , "data A = X {getV :: Int} | Y {getV :: Int}"+              , "data B = B"+              , "a,b :: ()"+              , "a = ()"+              , "b = ()"])+    ]+  where+    template = exportTemplate Nothing+++codeActionHelperFunctionTests :: TestTree+codeActionHelperFunctionTests = testGroup "code action helpers"+    [+    extendImportTestsRegEx+    ]++extendImportTestsRegEx :: TestTree+extendImportTestsRegEx = testGroup "regex parsing"+    [+      testCase "parse invalid multiple imports" $ template "foo bar foo" Nothing+    , testCase "parse malformed import list" $ template+                  "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n    \8216Data.Map\8217)"+                  Nothing+    , testCase "parse multiple imports" $ template+                 "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n    \8216Data.Map\8217 (app/testlsp.hs:7:1-18)\n    \8216Data.HashMap.Strict\8217 (app/testlsp.hs:8:1-29)"+                 $ Just ("fromList",[("Data.Map","app/testlsp.hs:7:1-18"),("Data.HashMap.Strict","app/testlsp.hs:8:1-29")])+    ]+    where+        template message expected = do+            liftIO $ matchRegExMultipleImports message @=? expected++pickActionWithTitle :: T.Text -> [Command |? CodeAction] -> IO CodeAction+pickActionWithTitle title actions = do+  assertBool ("Found no matching actions for " <> show title <> " in " <> show titles) (not $ null matches)+  return $ head matches+  where+    titles =+        [ actionTitle+        | InR CodeAction { _title = actionTitle } <- actions+        ]+    matches =+        [ action+        | InR action@CodeAction { _title = actionTitle } <- actions+        , title == actionTitle+        ]++findCodeActions :: TextDocumentIdentifier -> Range -> [T.Text] -> Session [CodeAction]+findCodeActions = findCodeActions' (==) "is not a superset of"++findCodeActionsByPrefix :: TextDocumentIdentifier -> Range -> [T.Text] -> Session [CodeAction]+findCodeActionsByPrefix = findCodeActions' T.isPrefixOf "is not prefix of"++findCodeActions' :: (T.Text -> T.Text -> Bool) -> String -> TextDocumentIdentifier -> Range -> [T.Text] -> Session [CodeAction]+findCodeActions' op errMsg doc range expectedTitles = do+  actions <- getCodeActions doc range+  let matches = sequence+        [ listToMaybe+          [ action+          | InR action@CodeAction { _title = actionTitle } <- actions+          , expectedTitle `op` actionTitle]+        | expectedTitle <- expectedTitles]+  let msg = show+            [ actionTitle+            | InR CodeAction { _title = actionTitle } <- actions+            ]+            ++ " " <> errMsg <> " "+            ++ show expectedTitles+  liftIO $ case matches of+    Nothing -> assertFailure msg+    Just _  -> pure ()+  return (fromJust matches)++findCodeAction :: TextDocumentIdentifier -> Range -> T.Text -> Session CodeAction+findCodeAction doc range t = head <$> findCodeActions doc range [t]++testSession :: String -> Session () -> TestTree+testSession name = testCase name . run++testSessionWithExtraFiles :: HasCallStack => FilePath -> String -> (FilePath -> Session ()) -> TestTree+testSessionWithExtraFiles prefix name = testCase name . runWithExtraFiles prefix++runWithExtraFiles :: HasCallStack => FilePath -> (FilePath -> Session a) -> IO a+runWithExtraFiles prefix s = withTempDir $ \dir -> do+  copyTestDataFiles dir prefix+  runInDir dir (s dir)++copyTestDataFiles :: HasCallStack => FilePath -> FilePath -> IO ()+copyTestDataFiles dir prefix = do+  -- Copy all the test data files to the temporary workspace+  testDataFiles <- getDirectoryFilesIO ("test/data" </> prefix) ["//*"]+  for_ testDataFiles $ \f -> do+    createDirectoryIfMissing True $ dir </> takeDirectory f+    copyFile ("test/data" </> prefix </> f) (dir </> f)++run :: Session a -> IO a+run s = run' (const s)++run' :: (FilePath -> Session a) -> IO a+run' s = withTempDir $ \dir -> runInDir dir (s dir)++runInDir :: FilePath -> Session a -> IO a+runInDir dir = runSessionWithServer' refactorPlugin def def lspTestCaps dir++lspTestCaps :: ClientCapabilities+lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }++pattern R :: UInt -> UInt -> UInt -> UInt -> Range+pattern R x y x' y' = Range (Position x y) (Position x' y')++-- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path+-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or+-- @/var@+withTempDir :: (FilePath -> IO a) -> IO a+withTempDir f = System.IO.Extra.withTempDir $ \dir -> do+  dir' <- canonicalizePath dir+  f dir'++ignoreForGHC92 :: String -> TestTree -> TestTree+ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92])++data BrokenTarget =+    BrokenSpecific OS [GhcVersion]+    -- ^Broken for `BrokenOS` with `GhcVersion`+    | BrokenForOS OS+    -- ^Broken for `BrokenOS`+    | BrokenForGHC [GhcVersion]+    -- ^Broken for `GhcVersion`+    deriving (Show)++-- | Ignore test for specific os and ghc with reason.+ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree+ignoreFor = knownIssueFor Ignore++-- | Deal with `IssueSolution` for specific OS and GHC.+knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree+knownIssueFor solution = go . \case+    BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers+    BrokenForOS bos         -> isTargetOS bos+    BrokenForGHC vers       -> isTargetGhc vers+    where+        isTargetOS = \case+            Windows -> isWindows+            MacOS   -> isMac+            Linux   -> not isWindows && not isMac++        isTargetGhc = elem ghcVersion++        go True = case solution of+            Broken -> expectFailBecause+            Ignore -> ignoreTestBecause+        go False = \_ -> id+++data IssueSolution = Broken | Ignore deriving (Show)++-- | Assert that a value is not 'Nothing', and extract the value.+assertJust :: MonadIO m => String -> Maybe a -> m a+assertJust s = \case+  Nothing -> liftIO $ assertFailure s+  Just x  -> pure x++-- | Before ghc9, lists of Char is displayed as [Char], but with ghc9 and up, it's displayed as String+listOfChar :: T.Text+listOfChar | ghcVersion >= GHC90 = "String"+           | otherwise = "[Char]"+
+ test/data/hiding/AVec.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeOperators #-}+module AVec (Vec, type (@@@), (++), cons, fromList, snoc) where++import Prelude hiding ((++))++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined++data (@@@) a b++fromList :: [a] -> Vec a+fromList = undefined++cons :: a -> Vec a -> Vec a+cons = undefined++snoc :: Vec a -> a -> Vec a+snoc = undefined
+ test/data/hiding/BVec.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeOperators #-}+module BVec (Vec, type (@@@), (++), cons, fromList, snoc) where++import Prelude hiding ((++))++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined++data (@@@) a b++fromList :: [a] -> Vec a+fromList = undefined++cons :: a -> Vec a -> Vec a+cons = undefined++snoc :: Vec a -> a -> Vec a+snoc = undefined
+ test/data/hiding/CVec.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeOperators #-}+module CVec (Vec, type (@@@), (++), cons, fromList, snoc) where++import Prelude hiding ((++))++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined++data (@@@) a b++fromList :: [a] -> Vec a+fromList = undefined++cons :: a -> Vec a -> Vec a+cons = undefined++snoc :: Vec a -> a -> Vec a+snoc = undefined
+ test/data/hiding/DVec.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeOperators #-}+module DVec (Vec, (++), type (@@@), cons, fromList, snoc) where++import Prelude hiding ((++))++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined++data (@@@) a b++fromList :: [a] -> Vec a+fromList = undefined++cons :: a -> Vec a -> Vec a+cons = undefined++snoc :: Vec a -> a -> Vec a+snoc = undefined
+ test/data/hiding/EVec.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeOperators #-}+module EVec (Vec, (++), type (@@@), cons, fromList, snoc) where++import Prelude hiding ((++))++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined++data (@@@) a b++fromList :: [a] -> Vec a+fromList = undefined++cons :: a -> Vec a -> Vec a+cons = undefined++snoc :: Vec a -> a -> Vec a+snoc = undefined
+ test/data/hiding/FVec.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE DuplicateRecordFields #-}++module FVec (RecA(..), RecB(..)) where++data Vec a++newtype RecA a = RecA { fromList :: [a] -> Vec a }++newtype RecB a = RecB { fromList :: [a] -> Vec a }
+ test/data/hiding/HideFunction.expected.append.E.hs view
@@ -0,0 +1,12 @@+module HideFunction where++import AVec (fromList)+import BVec (fromList)+import CVec hiding ((++), cons)+import DVec hiding ((++), cons, snoc)+import EVec as E+import Prelude hiding ((++))++theFun = fromList++theOp = (++)
+ test/data/hiding/HideFunction.expected.append.Prelude.hs view
@@ -0,0 +1,11 @@+module HideFunction where++import AVec (fromList)+import BVec (fromList)+import CVec hiding ((++), cons)+import DVec hiding ((++), cons, snoc)+import EVec as E hiding ((++))++theFun = fromList++theOp = (++)
+ test/data/hiding/HideFunction.expected.fromList.A.hs view
@@ -0,0 +1,11 @@+module HideFunction where++import AVec (fromList)+import BVec ( (++))+import CVec hiding (fromList, cons)+import DVec hiding (fromList, cons, snoc)+import EVec as E hiding (fromList)++theFun = fromList++theOp = (++)
+ test/data/hiding/HideFunction.expected.fromList.B.hs view
@@ -0,0 +1,11 @@+module HideFunction where++import AVec ()+import BVec (fromList, (++))+import CVec hiding (fromList, cons)+import DVec hiding (fromList, cons, snoc)+import EVec as E hiding (fromList)++theFun = fromList++theOp = (++)
+ test/data/hiding/HideFunction.expected.qualified.append.Prelude.hs view
@@ -0,0 +1,11 @@+module HideFunction where++import AVec (fromList)+import BVec (fromList, (++))+import CVec hiding (cons)+import DVec hiding (cons, snoc)+import EVec as E++theFun = fromList++theOp = (Prelude.++)
+ test/data/hiding/HideFunction.expected.qualified.fromList.E.hs view
@@ -0,0 +1,11 @@+module HideFunction where++import AVec (fromList)+import BVec (fromList, (++))+import CVec hiding (cons)+import DVec hiding (cons, snoc)+import EVec as E++theFun = E.fromList++theOp = (++)
+ test/data/hiding/HideFunction.hs view
@@ -0,0 +1,11 @@+module HideFunction where++import AVec (fromList)+import BVec (fromList, (++))+import CVec hiding (cons)+import DVec hiding (cons, snoc)+import EVec as E++theFun = fromList++theOp = (++)
+ test/data/hiding/HideFunctionWithoutLocal.expected.hs view
@@ -0,0 +1,14 @@+module HideFunctionWithoutLocal where++import AVec (fromList)+import BVec (fromList)+import CVec hiding ((++), cons)+import DVec hiding ((++), cons, snoc)+import EVec as E hiding ((++))+import Prelude hiding ((++))++theOp = (++)++data Vec a++(++) = undefined
+ test/data/hiding/HideFunctionWithoutLocal.hs view
@@ -0,0 +1,13 @@+module HideFunctionWithoutLocal where++import AVec (fromList)+import BVec (fromList, (++))+import CVec hiding (cons)+import DVec hiding (cons, snoc)+import EVec as E++theOp = (++)++data Vec a++(++) = undefined
+ test/data/hiding/HidePreludeIndented.expected.hs view
@@ -0,0 +1,5 @@+module HidePreludeIndented where++   import AVec+   import Prelude hiding ((++))+   op = (++)
+ test/data/hiding/HidePreludeIndented.hs view
@@ -0,0 +1,4 @@+module HidePreludeIndented where++   import AVec+   op = (++)
+ test/data/hiding/HidePreludeLocalInfix.expected.hs view
@@ -0,0 +1,9 @@+module HidePreludeLocalInfix where+import Prelude hiding ((++))++infixed xs ys = xs ++ ys++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined
+ test/data/hiding/HidePreludeLocalInfix.hs view
@@ -0,0 +1,8 @@+module HidePreludeLocalInfix where++infixed xs ys = xs ++ ys++data Vec a++(++) :: Vec a -> Vec a -> Vec a+(++) = undefined
+ test/data/hiding/HideQualifyDuplicateRecordFields.expected.hs view
@@ -0,0 +1,10 @@+module HideQualifyDuplicateRecordFields where++import AVec+import BVec+import CVec+import DVec+import EVec+import FVec++theFun = AVec.fromList
+ test/data/hiding/HideQualifyDuplicateRecordFields.hs view
@@ -0,0 +1,10 @@+module HideQualifyDuplicateRecordFields where++import AVec+import BVec+import CVec+import DVec+import EVec+import FVec++theFun = fromList
+ test/data/hiding/HideQualifyDuplicateRecordFieldsSelf.hs view
@@ -0,0 +1,5 @@+module HideQualifyDuplicateRecordFieldsSelf where++import FVec++x = fromList
+ test/data/hiding/HideQualifyInfix.expected.hs view
@@ -0,0 +1,5 @@+module HideQualifyInfix where++import AVec++infixed xs ys = xs Prelude.++ ys
+ test/data/hiding/HideQualifyInfix.hs view
@@ -0,0 +1,5 @@+module HideQualifyInfix where++import AVec++infixed xs ys = xs ++ ys
+ test/data/hiding/HideQualifySectionLeft.expected.hs view
@@ -0,0 +1,5 @@+module HideQualifySectionLeft where++import AVec++sectLeft xs = (Prelude.++ xs)
+ test/data/hiding/HideQualifySectionLeft.hs view
@@ -0,0 +1,5 @@+module HideQualifySectionLeft where++import AVec++sectLeft xs = (++ xs)
+ test/data/hiding/HideQualifySectionRight.expected.hs view
@@ -0,0 +1,5 @@+module HideQualifySectionRight where++import AVec++sectLeft xs = (xs Prelude.++)
+ test/data/hiding/HideQualifySectionRight.hs view
@@ -0,0 +1,5 @@+module HideQualifySectionRight where++import AVec++sectLeft xs = (xs ++)
+ test/data/hiding/HideType.expected.A.hs view
@@ -0,0 +1,9 @@+module HideType where++import AVec (Vec, fromList)+import BVec (fromList, (++))+import CVec hiding (Vec, cons)+import DVec hiding (Vec, cons, snoc)+import EVec as E hiding (Vec)++type TheType = Vec
+ test/data/hiding/HideType.expected.E.hs view
@@ -0,0 +1,9 @@+module HideType where++import AVec ( fromList)+import BVec (fromList, (++))+import CVec hiding (Vec, cons)+import DVec hiding (Vec, cons, snoc)+import EVec as E++type TheType = Vec
+ test/data/hiding/HideType.hs view
@@ -0,0 +1,9 @@+module HideType where++import AVec (Vec, fromList)+import BVec (fromList, (++))+import CVec hiding (cons)+import DVec hiding (cons, snoc)+import EVec as E++type TheType = Vec
+ test/data/hiding/hie.yaml view
@@ -0,0 +1,11 @@+cradle:+    direct:+        arguments:+        - -Wall+        - HideFunction.hs+        - AVec.hs+        - BVec.hs+        - CVec.hs+        - DVec.hs+        - EVec.hs+        - FVec.hs
+ test/data/hover/Bar.hs view
@@ -0,0 +1,4 @@+module Bar (Bar(..)) where++-- | Bar Haddock+data Bar = Bar
+ test/data/hover/Foo.hs view
@@ -0,0 +1,6 @@+module Foo (Bar, foo) where++import Bar++-- | foo Haddock+foo = Bar
+ test/data/hover/GotoHover.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+{- HLINT ignore -}+module GotoHover ( module GotoHover) where+import Data.Text (Text, pack)+import Foo (Bar, foo)+++data TypeConstructor = DataConstructor+  { fff :: Text+  , ggg :: Int }+aaa :: TypeConstructor+aaa = DataConstructor+  { fff = "dfgy"+  , ggg = 832+  }+bbb :: TypeConstructor+bbb = DataConstructor "mjgp" 2994+ccc :: (Text, Int)+ccc = (fff bbb, ggg aaa)+ddd :: Num a => a -> a -> a+ddd vv ww = vv +! ww+a +! b = a - b+hhh (Just a) (><) = a >< a+iii a b = a `b` a+jjj s = pack $ s <> s+class MyClass a where+  method :: a -> Int+instance MyClass Int where+  method = succ+kkk :: MyClass a => Int -> a -> Int+kkk n c = n + method c++doBind :: Maybe ()+doBind = do unwrapped <- Just ()+            return unwrapped++listCompBind :: [Char]+listCompBind = [ succ c | c <- "ptfx" ]++multipleClause :: Bool -> Char+multipleClause True  =    't'+multipleClause False = 'f'++-- | Recognizable docs: kpqz+documented :: Monad m => Either Int (m a)+documented = Left 7518++listOfInt = [ 8391 :: Int, 6268 ]++outer :: Bool+outer = undefined inner where++  inner :: Char+  inner = undefined++imported :: Bar+imported = foo++aa2 :: Bool+aa2 = $(id [| True |])++hole :: Int+hole = _++hole2 :: a -> Maybe a+hole2 = _
+ test/data/hover/RecordDotSyntax.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 902+{-# LANGUAGE OverloadedRecordDot, DuplicateRecordFields, NoFieldSelectors #-}++module RecordDotSyntax ( module RecordDotSyntax) where++import qualified Data.Maybe as M++data MyRecord = MyRecord+  { a :: String+  , b :: Integer+  , c :: MyChild+  } deriving (Eq, Show)++newtype MyChild = MyChild+  { z :: String+  } deriving (Eq, Show)++x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } }+y = x.a ++ show x.b ++ x.c.z+#endif
+ test/data/hover/hie.yaml view
@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["Foo", "Bar", "GotoHover", "RecordDotSyntax"]}}
+ test/data/import-placement/CommentAtTop.expected.hs view
@@ -0,0 +1,9 @@+module Test+( SomeData(..)+) where+import Data.Monoid++-- | Some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/CommentAtTop.hs view
@@ -0,0 +1,8 @@+module Test+( SomeData(..)+) where++-- | Some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/CommentAtTopMultipleComments.expected.hs view
@@ -0,0 +1,12 @@+module Test+( SomeData(..)+) where+import Data.Monoid++-- | Another comment+data SomethingElse = SomethingElse++-- | Some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/CommentAtTopMultipleComments.hs view
@@ -0,0 +1,11 @@+module Test+( SomeData(..)+) where++-- | Another comment+data SomethingElse = SomethingElse++-- | Some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/CommentCurlyBraceAtTop.expected.hs view
@@ -0,0 +1,9 @@+module Test+( SomeData(..)+) where+import Data.Monoid++{- Some comment -}+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/CommentCurlyBraceAtTop.hs view
@@ -0,0 +1,8 @@+module Test+( SomeData(..)+) where++{- Some comment -}+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/DataAtTop.expected.hs view
@@ -0,0 +1,11 @@+module Test+( SomeData(..)+) where+import Data.Monoid++data Something = Something++-- | some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/DataAtTop.hs view
@@ -0,0 +1,10 @@+module Test+( SomeData(..)+) where++data Something = Something++-- | some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/ImportAtTop.expected.hs view
@@ -0,0 +1,14 @@+module Test+( SomeData(..)+) where++import Data.Char+import Data.Monoid++{- Some multi +   line comment +-}+class Semigroup a => SomeData a++-- | a comment+instance SomeData All
+ test/data/import-placement/ImportAtTop.hs view
@@ -0,0 +1,13 @@+module Test+( SomeData(..)+) where++import Data.Char++{- Some multi +   line comment +-}+class Semigroup a => SomeData a++-- | a comment+instance SomeData All
+ test/data/import-placement/LangPragmaModuleAtTop.expected.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}++module Test where+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LangPragmaModuleAtTop.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}++module Test where++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LangPragmaModuleExplicitExports.expected.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}++module Test+( SomeData(..)+) where+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LangPragmaModuleExplicitExports.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}++module Test+( SomeData(..)+) where++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LangPragmaModuleWithComment.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}++module Test+( SomeData(..)+) where+import Data.Monoid++-- comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LangPragmaModuleWithComment.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}++module Test+( SomeData(..)+) where++-- comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LanguagePragmaAtTop.expected.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LanguagePragmaAtTop.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LanguagePragmaAtTopWithComment.expected.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.Monoid++-- | comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LanguagePragmaAtTopWithComment.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE OverloadedStrings #-}++-- | comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LanguagePragmasThenShebangs.expected.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+import Data.Monoid++-- some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/LanguagePragmasThenShebangs.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++-- some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/ModuleDeclAndImports.expected.hs view
@@ -0,0 +1,10 @@+module Test+( SomeData(..)+) where+import Data.Char+import Data.Array+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/ModuleDeclAndImports.hs view
@@ -0,0 +1,9 @@+module Test+( SomeData(..)+) where+import Data.Char+import Data.Array++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/MultiLineCommentAtTop.expected.hs view
@@ -0,0 +1,11 @@+module Test+( SomeData(..)+) where+import Data.Monoid++{- Some multi +   line comment +-}+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/MultiLineCommentAtTop.hs view
@@ -0,0 +1,10 @@+module Test+( SomeData(..)+) where++{- Some multi +   line comment +-}+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/MultiLinePragma.expected.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards, +   OverloadedStrings #-}+{-# OPTIONS_GHC -Wall,+  -Wno-unused-imports #-}+import Data.Monoid+++-- some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/MultiLinePragma.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards, +   OverloadedStrings #-}+{-# OPTIONS_GHC -Wall,+  -Wno-unused-imports #-}+++-- some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/MultipleImportsAtTop.expected.hs view
@@ -0,0 +1,14 @@+module Test+( SomeData(..)+) where++import Data.Char+import Data.Bool+import Data.Eq+import Data.Monoid++-- | A comment+class Semigroup a => SomeData a++-- | another comment+instance SomeData All
+ test/data/import-placement/MultipleImportsAtTop.hs view
@@ -0,0 +1,13 @@+module Test+( SomeData(..)+) where++import Data.Char+import Data.Bool+import Data.Eq++-- | A comment+class Semigroup a => SomeData a++-- | another comment+instance SomeData All
+ test/data/import-placement/MultipleLanguagePragmasNoModuleDeclaration.expected.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RankNTypes #-}+import Data.Monoid++-- some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/MultipleLanguagePragmasNoModuleDeclaration.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RankNTypes #-}++-- some comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NewTypeAtTop.expected.hs view
@@ -0,0 +1,11 @@+module Test+( SomeData(..)+) where+import Data.Monoid++newtype Something = S { foo :: Int }++-- | a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NewTypeAtTop.hs view
@@ -0,0 +1,10 @@+module Test+( SomeData(..)+) where++newtype Something = S { foo :: Int }++-- | a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoExplicitExportCommentAtTop.expected.hs view
@@ -0,0 +1,7 @@+module Test where+import Data.Monoid++-- | a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoExplicitExportCommentAtTop.hs view
@@ -0,0 +1,6 @@+module Test where++-- | a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoExplicitExports.expected.hs view
@@ -0,0 +1,8 @@+module Test where+import Data.Monoid++newtype Something = S { foo :: Int }++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoExplicitExports.hs view
@@ -0,0 +1,7 @@+module Test where++newtype Something = S { foo :: Int }++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoModuleDeclaration.expected.hs view
@@ -0,0 +1,7 @@+import Data.Monoid+newtype Something = S { foo :: Int }++-- | a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoModuleDeclaration.hs view
@@ -0,0 +1,6 @@+newtype Something = S { foo :: Int }++-- | a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoModuleDeclarationCommentAtTop.expected.hs view
@@ -0,0 +1,5 @@+import Data.Monoid+-- a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/NoModuleDeclarationCommentAtTop.hs view
@@ -0,0 +1,4 @@+-- a comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/OptionsNotAtTopWithSpaces.expected.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}+++{-# LANGUAGE TupleSections #-}+import Data.Monoid+++++class Semigroup a => SomeData a+instance SomeData All++{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/OptionsNotAtTopWithSpaces.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+++{-# LANGUAGE TupleSections #-}+++++class Semigroup a => SomeData a+instance SomeData All++{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/OptionsPragmaNotAtTop.expected.hs view
@@ -0,0 +1,8 @@+import Data.Monoid+class Semigroup a => SomeData a+instance SomeData All++{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/OptionsPragmaNotAtTop.hs view
@@ -0,0 +1,7 @@+class Semigroup a => SomeData a+instance SomeData All++{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopMultipleComments.expected.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -Wall,+   OPTIONS_GHC -Wno-unrecognised-pragmas #-}+-- another comment+-- oh+{- multi line +comment+-}++{-# LANGUAGE TupleSections #-}+import Data.Monoid+{- some comment -}++-- again+class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopMultipleComments.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -Wall,+   OPTIONS_GHC -Wno-unrecognised-pragmas #-}+-- another comment+-- oh+{- multi line +comment+-}++{-# LANGUAGE TupleSections #-}+{- some comment -}++-- again+class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopWithCommentsAtTop.expected.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -Wall #-}+-- another comment++{-# LANGUAGE TupleSections #-}+import Data.Monoid+{- some comment -}+++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopWithCommentsAtTop.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -Wall #-}+-- another comment++{-# LANGUAGE TupleSections #-}+{- some comment -}+++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopWithImports.expected.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TupleSections #-}+module Test+( SomeData(..)+) where+import Data.Text+import Data.Monoid+++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopWithImports.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TupleSections #-}+module Test+( SomeData(..)+) where+import Data.Text+++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopWithModuleDecl.expected.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+++{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TupleSections #-}+module Test+( SomeData(..)+) where+import Data.Monoid+++++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmaNotAtTopWithModuleDecl.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+++{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TupleSections #-}+module Test+( SomeData(..)+) where+++++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/PragmasAndShebangsNoComment.expected.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasAndShebangsNoComment.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasShebangsAndModuleDecl.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++module Test where+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasShebangsAndModuleDecl.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++module Test where++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasShebangsModuleExplicitExports.expected.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++module Test+( SomeData(..)+) where+import Data.Monoid++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasShebangsModuleExplicitExports.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++module Test+( SomeData(..)+) where++class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasThenShebangsMultilineComment.expected.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+import Data.Monoid++{- | some multiline+  comment+   ... -}+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/PragmasThenShebangsMultilineComment.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++{- | some multiline+  comment+   ... -}+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/ShebangNotAtTop.expected.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.Monoid++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++f :: Int -> Int +f x = x * x
+ test/data/import-placement/ShebangNotAtTop.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++f :: Int -> Int +f x = x * x
+ test/data/import-placement/ShebangNotAtTopNoSpace.expected.hs view
@@ -0,0 +1,8 @@+import Data.Monoid+class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++f :: Int -> Int +f x = x * x
+ test/data/import-placement/ShebangNotAtTopNoSpace.hs view
@@ -0,0 +1,7 @@+class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++f :: Int -> Int +f x = x * x
+ test/data/import-placement/ShebangNotAtTopWithSpaces.expected.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+++{-# OPTIONS_GHC -Wall #-}++++{-# LANGUAGE TupleSections #-}+import Data.Monoid+++++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/ShebangNotAtTopWithSpaces.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}+++{-# OPTIONS_GHC -Wall #-}++++{-# LANGUAGE TupleSections #-}+++++class Semigroup a => SomeData a+instance SomeData All++#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++addOne :: Int -> Int+addOne x = x + 1
+ test/data/import-placement/TwoDashOnlyComment.expected.hs view
@@ -0,0 +1,9 @@+module Test+( SomeData(..)+) where+import Data.Monoid++-- no vertical bar comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/TwoDashOnlyComment.hs view
@@ -0,0 +1,8 @@+module Test+( SomeData(..)+) where++-- no vertical bar comment+class Semigroup a => SomeData a++instance SomeData All
+ test/data/import-placement/WhereDeclLowerInFile.expected.hs view
@@ -0,0 +1,18 @@+module Asdf + (f+ , where') + + where+import Data.Int++++f :: Int64 -> Int64+f = id'+  where id' = id++g :: Int -> Int +g = id++where' :: Int -> Int +where' = id
+ test/data/import-placement/WhereDeclLowerInFile.hs view
@@ -0,0 +1,17 @@+module Asdf + (f+ , where') + + where++++f :: Int64 -> Int64+f = id'+  where id' = id++g :: Int -> Int +g = id++where' :: Int -> Int +where' = id
+ test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs view
@@ -0,0 +1,20 @@+module Asdf+ (f+ , where')+-- hello+-- world++ where+import Data.Int++++f :: Int64 -> Int64+f = id'+  where id' = id++g :: Int -> Int+g = id++where' :: Int -> Int+where' = id
+ test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.hs view
@@ -0,0 +1,19 @@+module Asdf+ (f+ , where')+-- hello+-- world++ where++++f :: Int64 -> Int64+f = id'+  where id' = id++g :: Int -> Int+g = id++where' :: Int -> Int+where' = id
+ test/data/import-placement/WhereKeywordLowerInFileNoExports.expected.hs view
@@ -0,0 +1,16 @@+module Asdf + + + where+import Data.Int+++f :: Int64 -> Int64+f = id'+  where id' = id++g :: Int -> Int +g = id++where' :: Int -> Int +where' = id
+ test/data/import-placement/WhereKeywordLowerInFileNoExports.hs view
@@ -0,0 +1,15 @@+module Asdf + + + where+++f :: Int64 -> Int64+f = id'+  where id' = id++g :: Int -> Int +g = id++where' :: Int -> Int +where' = id