ghcide 1.1.0.0 → 1.2.0.0

raw patch · 109 files changed

+1822/−739 lines, 109 filesdep +aeson-prettydep +ghc-trace-eventsdep ~Diffdep ~base16-bytestringdep ~haddock-librarynew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson-pretty, ghc-trace-events

Dependency ranges changed: Diff, base16-bytestring, haddock-library, hls-plugin-api, lsp, lsp-test, lsp-types, regex-tdfa

API changes (from Hackage documentation)

Files

• CHANGELOG.md +34/−0
• exe/Arguments.hs +21/−28
• exe/Main.hs +46/−55
• ghcide.cabal +29/−21
• session-loader/Development/IDE/Session.hs +3/−2
• src/Development/IDE.hs +6/−4
• src/Development/IDE/Core/Actions.hs +127/−0
• src/Development/IDE/Core/Compile.hs +24/−11
• src/Development/IDE/Core/FileStore.hs +12/−4
• src/Development/IDE/Core/OfInterest.hs +1/−1
• src/Development/IDE/Core/PositionMapping.hs +1/−0
• src/Development/IDE/Core/Rules.hs +58/−145
• src/Development/IDE/Core/Shake.hs +33/−21
• src/Development/IDE/Core/Tracing.hs +24/−27
• src/Development/IDE/Core/UseStale.hs +158/−0
• src/Development/IDE/LSP/HoverDefinition.hs +1/−0
• src/Development/IDE/LSP/LanguageServer.hs +22/−35
• src/Development/IDE/LSP/Notifications.hs +21/−20
• src/Development/IDE/LSP/Outline.hs +5/−6
• src/Development/IDE/Main.hs +113/−25
• src/Development/IDE/Plugin/CodeAction.hs +146/−65
• src/Development/IDE/Plugin/CodeAction/Args.hs +10/−6
• src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +41/−101
• src/Development/IDE/Plugin/Completions.hs +4/−4
• src/Development/IDE/Plugin/Completions/Logic.hs +20/−17
• src/Development/IDE/Plugin/Completions/Types.hs +30/−0
• src/Development/IDE/Plugin/HLS.hs +53/−12
• src/Development/IDE/Plugin/HLS/GhcIde.hs +15/−13
• src/Development/IDE/Plugin/TypeLenses.hs +32/−22
• src/Development/IDE/Spans/AtPoint.hs +1/−1
• src/Development/IDE/Spans/Common.hs +8/−1
• src/Development/IDE/Types/Exports.hs +13/−4
• src/Development/IDE/Types/HscEnvEq.hs +6/−4
• src/Development/IDE/Types/KnownTargets.hs +2/−2
• src/Development/IDE/Types/Options.hs +9/−0
• test/data/TH/THA.hs +6/−0
• test/data/TH/THB.hs +5/−0
• test/data/TH/THC.hs +5/−0
• test/data/TH/hie.yaml +1/−0
• test/data/THNewName/A.hs +6/−0
• test/data/THNewName/B.hs +5/−0
• test/data/THNewName/C.hs +4/−0
• test/data/THNewName/hie.yaml +1/−0
• test/data/THUnboxed/THA.hs +9/−0
• test/data/THUnboxed/THB.hs +5/−0
• test/data/THUnboxed/THC.hs +5/−0
• test/data/THUnboxed/hie.yaml +1/−0
• test/data/boot/A.hs +10/−0
• test/data/boot/A.hs-boot +3/−0
• test/data/boot/B.hs +7/−0
• test/data/boot/C.hs +8/−0
• test/data/boot/hie.yaml +1/−0
• test/data/cabal-exe/a/a.cabal +14/−0
• test/data/cabal-exe/a/src/Main.hs +3/−0
• test/data/cabal-exe/cabal.project +1/−0
• test/data/cabal-exe/hie.yaml +3/−0
• test/data/hiding/AVec.hs +20/−0
• test/data/hiding/BVec.hs +20/−0
• test/data/hiding/CVec.hs +20/−0
• test/data/hiding/DVec.hs +20/−0
• test/data/hiding/EVec.hs +20/−0
• test/data/hiding/FVec.hs +9/−0
• test/data/hiding/HideFunction.expected.append.E.hs +12/−0
• test/data/hiding/HideFunction.expected.append.Prelude.hs +11/−0
• test/data/hiding/HideFunction.expected.fromList.A.hs +11/−0
• test/data/hiding/HideFunction.expected.fromList.B.hs +11/−0
• test/data/hiding/HideFunction.expected.qualified.append.Prelude.hs +11/−0
• test/data/hiding/HideFunction.expected.qualified.fromList.E.hs +11/−0
• test/data/hiding/HideFunction.hs +11/−0
• test/data/hiding/HidePreludeIndented.expected.hs +5/−0
• test/data/hiding/HidePreludeIndented.hs +4/−0
• test/data/hiding/HideQualifyDuplicateRecordFields.expected.hs +10/−0
• test/data/hiding/HideQualifyDuplicateRecordFields.hs +10/−0
• test/data/hiding/HideQualifyDuplicateRecordFieldsSelf.hs +5/−0
• test/data/hiding/HideQualifyInfix.expected.hs +5/−0
• test/data/hiding/HideQualifyInfix.hs +5/−0
• test/data/hiding/HideQualifySectionLeft.expected.hs +5/−0
• test/data/hiding/HideQualifySectionLeft.hs +5/−0
• test/data/hiding/HideQualifySectionRight.expected.hs +5/−0
• test/data/hiding/HideQualifySectionRight.hs +5/−0
• test/data/hiding/HideType.expected.A.hs +9/−0
• test/data/hiding/HideType.expected.E.hs +9/−0
• test/data/hiding/HideType.hs +9/−0
• test/data/hiding/hie.yaml +10/−0
• test/data/hover/hie.yaml +1/−0
• test/data/ignore-fatal/IgnoreFatal.hs +8/−0
• test/data/ignore-fatal/cabal.project +1/−0
• test/data/ignore-fatal/hie.yaml +4/−0
• test/data/ignore-fatal/ignore-fatal.cabal +10/−0
• test/data/plugin-knownnat/KnownNat.hs +10/−0
• test/data/plugin-knownnat/cabal.project +1/−0
• test/data/plugin-knownnat/plugin.cabal +9/−0
• test/data/plugin-recorddot/RecordDot.hs +6/−0
• test/data/plugin-recorddot/cabal.project +1/−0
• test/data/plugin-recorddot/plugin.cabal +9/−0
• test/data/recomp/A.hs +6/−0
• test/data/recomp/B.hs +4/−0
• test/data/recomp/P.hs +5/−0
• test/data/recomp/hie.yaml +1/−0
• test/data/references/Main.hs +14/−0
• test/data/references/OtherModule.hs +9/−0
• test/data/references/OtherOtherModule.hs +3/−0
• test/data/references/References.hs +25/−0
• test/data/references/hie.yaml +1/−0
• test/data/rootUri/dirA/Foo.hs +3/−0
• test/data/rootUri/dirA/foo.cabal +9/−0
• test/data/rootUri/dirB/Foo.hs +3/−0
• test/data/rootUri/dirB/foo.cabal +9/−0
• test/exe/Main.hs +150/−82

@@ -1,3 +1,37 @@+### 1.2.0 (2021-04-11)+* Emit holes as diagnostics (#1653) - Sandy Maguire+* Fix ghcide and HLS enter lsp mode by default (#1692) - Potato Hatsue+* support custom Ide commands (#1666) - Pepe Iborra+* ghcide - enable ApplicativeDo everywhere (#1667) - Pepe Iborra+* Intelligent derivations of Semigroup and Monoid for Wingman (#1671) - Sandy Maguire+* Avoid creating IsFileOfInterest keys for non workspace files (#1661) - Pepe Iborra+* Fix a wingman bug caused by mismanaged stale data (#1657) - Sandy Maguire+* Skip tracing unless eventlog is enabled (#1658) - Pepe Iborra+* optimize ambiguity import suggestions (#1669) - Lei Zhu+* Replace Barrier with MVar in lsp main (#1668) - Potato Hatsue+* Add bounds for Diff (#1665) - Potato Hatsue+* log exceptions before killing the server (#1651) - Pepe Iborra+* Fix importing type operators (#1644) - Potato Hatsue+* Shut the Shake session on exit, instead of restarting it (#1655) - Pepe Iborra+* Do not override custom user commands (#1650) - Pepe Iborra+* Civilized indexing progress reporting (#1633) - Pepe Iborra+* Avoid reordering plugins (#1629) - Pepe Iborra+* Update to lsp-1.2 (#1631) - wz1000+* Use custom config for completions plugin (#1619) - Potato Hatsue+* Configurable I/O handles (#1617) - Pepe Iborra+* Add test data files to extra-source-files (#1605) - Javier Neira+* Allow for customizable Haskell views of Property types (#1608) - Sandy Maguire+* Extract hls-test-utils (#1606) - Potato Hatsue+* Add ability for plugins to handle file change notifications (#1588) - Pepe Iborra+* Bump haddock-library to 1.10.0 (#1598) - Potato Hatsue+* Use CiInterface/SkInterface for typeclass symbols (#1592) - FW+* Relax ghcides upper bound on base16-bytestring (#1595) - maralorn+* Regularize custom config of plugins (#1576) - Potato Hatsue+* Avoid duplicating known targets and import paths (#1590) - Pepe Iborra+* Update homepage and other urls for ghcide (#1580) - Felix Yan+* Add custom code action kinds for import related code actions (#1570) - Potato Hatsue+* Use TextEdit to insert new imports (#1554) - Potato Hatsue+ ### 1.1.0 (2021-03-09) * Add an option to control progress reporting (#1513) - Pepe Iborra * Fix missing parens of auto extending imports (#1526) - Potato Hatsue

@@ -1,26 +1,23 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -module Arguments(Arguments, Arguments'(..), getArguments, IdeCmd(..)) where+module Arguments(Arguments(..), getArguments) where -import           HieDb.Run+import           Development.IDE.Main (Command (..), commandP) import           Options.Applicative -type Arguments = Arguments' IdeCmd--data IdeCmd = Typecheck [FilePath] | DbCmd Options Command | LSP--data Arguments' a = Arguments-    {argLSP                :: Bool-    ,argsCwd               :: Maybe FilePath-    ,argsVersion           :: Bool-    ,argsShakeProfiling    :: Maybe FilePath-    ,argsOTMemoryProfiling :: Bool-    ,argsTesting           :: Bool-    ,argsDisableKick       :: Bool-    ,argsThreads           :: Int-    ,argsVerbose           :: Bool-    ,argFilesOrCmd         :: a+data Arguments = Arguments+    {argsCwd                   :: Maybe FilePath+    ,argsVersion               :: Bool+    ,argsVSCodeExtensionSchema :: Bool+    ,argsDefaultConfig         :: Bool+    ,argsShakeProfiling        :: Maybe FilePath+    ,argsOTMemoryProfiling     :: Bool+    ,argsTesting               :: Bool+    ,argsDisableKick           :: Bool+    ,argsThreads               :: Int+    ,argsVerbose               :: Bool+    ,argsCommand               :: Command     }  getArguments :: IO Arguments@@ -32,21 +29,17 @@  arguments :: Parser Arguments arguments = Arguments-      <$> switch (long "lsp" <> help "Start talking to an LSP client")-      <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")+      <$> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")       <*> switch (long "version" <> help "Show ghcide and GHC versions")+      <*> switch (long "vscode-extension-schema" <> help "Print generic config schema for plugins (used in the package.json of haskell vscode extension)")+      <*> switch (long "generate-default-config" <> help "Print config supported by the server with default values")       <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory")       <*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect")       <*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite")       <*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation")       <*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)       <*> switch (long "verbose" <> help "Include internal events in logging output")-      <*> ( hsubparser (command "typecheck" (info (Typecheck <$> fileCmd) fileInfo)-                   <> command "hiedb" (info (DbCmd <$> optParser "" True <*> cmdParser <**> helper) hieInfo)-                   <> command "lsp" (info (pure LSP <**> helper) lspInfo)  )-         <|> Typecheck <$> fileCmd )-  where-    fileCmd = many (argument str (metavar "FILES/DIRS..."))-    lspInfo = fullDesc <> progDesc "Start talking to an LSP client"-    fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work"-    hieInfo = fullDesc <> progDesc "Query .hie files"+      <*> (commandP <|> lspCommand <|> checkCommand)+      where+          checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))+          lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP client")

@@ -5,15 +5,17 @@  module Main(main) where -import           Arguments                         (Arguments' (..),-                                                    IdeCmd (..), getArguments)+import           Arguments                         (Arguments (..),+                                                    getArguments) import           Control.Concurrent.Extra          (newLock, withLock) import           Control.Monad.Extra               (unless, when, whenJust)+import qualified Data.Aeson.Encode.Pretty          as A import           Data.Default                      (Default (def)) import           Data.List.Extra                   (upper)-import           Data.Maybe                        (fromMaybe) import qualified Data.Text                         as T import qualified Data.Text.IO                      as T+import           Data.Text.Lazy.Encoding           (decodeUtf8)+import qualified Data.Text.Lazy.IO                 as LT import           Data.Version                      (showVersion) import           Development.GitRev                (gitHash) import           Development.IDE                   (Logger (Logger),@@ -23,18 +25,16 @@ import qualified Development.IDE.Main              as Main import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde import qualified Development.IDE.Plugin.Test       as Test-import           Development.IDE.Session           (getHieDbLoc,-                                                    setInitialDynFlags) import           Development.IDE.Types.Options import           Development.Shake                 (ShakeOptions (shakeThreads))-import           HieDb.Run                         (Options (..), runCommand) import           Ide.Plugin.Config                 (Config (checkParents, checkProject))+import           Ide.Plugin.ConfigUtils            (pluginsToDefaultConfig,+                                                    pluginsToVSCodeExtensionSchema) import           Ide.PluginUtils                   (pluginDescToIdePlugins) import           Paths_ghcide                      (version) import qualified System.Directory.Extra            as IO import           System.Environment                (getExecutablePath)-import           System.Exit                       (ExitCode (ExitFailure),-                                                    exitSuccess, exitWith)+import           System.Exit                       (exitSuccess) import           System.IO                         (hPutStrLn, stderr) import           System.Info                       (compilerVersion) @@ -58,6 +58,16 @@     if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess     else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion +    let hlsPlugins = pluginDescToIdePlugins GhcIde.descriptors++    when argsVSCodeExtensionSchema $ do+      LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToVSCodeExtensionSchema hlsPlugins+      exitSuccess++    when argsDefaultConfig $ do+      LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig hlsPlugins+      exitSuccess+     whenJust argsCwd IO.setCurrentDirectory      -- lock to avoid overlapping output on stdout@@ -66,56 +76,37 @@             T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg         logLevel = if argsVerbose then minBound else Info -    case argFilesOrCmd of-      DbCmd opts cmd -> do-        dir <- IO.getCurrentDirectory-        dbLoc <- getHieDbLoc dir-        mlibdir <- setInitialDynFlags def-        case mlibdir of-          Nothing     -> exitWith $ ExitFailure 1-          Just libdir -> runCommand libdir opts{database = dbLoc} cmd--      _ -> do--          case argFilesOrCmd of-              LSP -> do-                hPutStrLn stderr "Starting LSP server..."-                hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"-              _ -> return ()--          Main.defaultMain def-            {Main.argFiles = case argFilesOrCmd of-                Typecheck x | not argLSP -> Just x-                _                        -> Nothing+    Main.defaultMain def+        {Main.argCommand = argsCommand -            ,Main.argsLogger = pure logger+        ,Main.argsLogger = pure logger -            ,Main.argsRules = do-                -- install the main and ghcide-plugin rules-                mainRule-                -- install the kick action, which triggers a typecheck on every-                -- Shake database restart, i.e. on every user edit.-                unless argsDisableKick $-                    action kick+        ,Main.argsRules = do+            -- install the main and ghcide-plugin rules+            mainRule+            -- install the kick action, which triggers a typecheck on every+            -- Shake database restart, i.e. on every user edit.+            unless argsDisableKick $+                action kick -            ,Main.argsHlsPlugins =-                pluginDescToIdePlugins $-                GhcIde.descriptors-                ++ [Test.blockCommandDescriptor "block-command" | argsTesting]+        ,Main.argsHlsPlugins =+            pluginDescToIdePlugins $+            GhcIde.descriptors+            ++ [Test.blockCommandDescriptor "block-command" | argsTesting] -            ,Main.argsGhcidePlugin = if argsTesting-                then Test.plugin-                else mempty+        ,Main.argsGhcidePlugin = if argsTesting+            then Test.plugin+            else mempty -            ,Main.argsIdeOptions = \(fromMaybe def -> config) sessionLoader ->-                let defOptions = defaultIdeOptions sessionLoader-                in defOptions-                  { optShakeProfiling = argsShakeProfiling-                  , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling-                  , optTesting = IdeTesting argsTesting-                  , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}-                  , optCheckParents = pure $ checkParents config-                  , optCheckProject = pure $ checkProject config-                  }-            }+        ,Main.argsIdeOptions = \config  sessionLoader ->+            let defOptions = defaultIdeOptions sessionLoader+            in defOptions+                { optShakeProfiling = argsShakeProfiling+                , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling+                , optTesting = IdeTesting argsTesting+                , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}+                , optCheckParents = pure $ checkParents config+                , optCheckProject = pure $ checkProject config+                }+        } 

@@ -1,8 +1,8 @@-cabal-version:      2.2+cabal-version:      2.4 build-type:         Simple category:           Development name:               ghcide-version:            1.1.0.0+version:            1.2.0.0 license:            Apache-2.0 license-file:       LICENSE author:             Digital Asset and Ghcide contributors@@ -11,21 +11,19 @@ synopsis:           The core of an IDE description:     A library for building Haskell IDE's on top of the GHC API.-homepage:           https://github.com/haskell/ghcide#readme-bug-reports:        https://github.com/haskell/ghcide/issues+homepage:           https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme+bug-reports:        https://github.com/haskell/haskell-language-server/issues tested-with:        GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.2 || == 8.10.3 || == 8.10.4 extra-source-files: include/ghc-api-version.h README.md CHANGELOG.md-                    test/data/hover/*.hs-                    test/data/multi/cabal.project-                    test/data/multi/hie.yaml-                    test/data/multi/a/a.cabal-                    test/data/multi/a/*.hs-                    test/data/multi/b/b.cabal-                    test/data/multi/b/*.hs+                    test/data/**/*.project+                    test/data/**/*.cabal+                    test/data/**/*.yaml+                    test/data/**/*.hs+                    test/data/**/*.hs-boot  source-repository head     type:     git-    location: https://github.com/haskell/ghcide.git+    location: https://github.com/haskell/haskell-language-server.git  flag ghc-patched-unboxed-bytecode     description: The GHC version we link against supports unboxed sums and tuples in bytecode@@ -54,17 +52,19 @@         filepath,         fingertree,         ghc-exactprint,+        ghc-trace-events,         Glob,-        haddock-library >= 1.8 && < 1.10,+        haddock-library ^>= 1.10.0,         hashable,         hie-compat ^>= 0.1.0.0,-        hls-plugin-api ^>= 1.0.0.0,+        hls-plugin-api ^>= 1.1.0.0,         lens,         hiedb == 0.3.0.1,-        lsp-types == 1.1.*,-        lsp == 1.1.1.0,+        lsp-types == 1.2.*,+        lsp == 1.2.*,         mtl,         network-uri,+        optparse-applicative,         parallel,         prettyprinter-ansi-terminal,         prettyprinter-ansi-terminal,@@ -86,7 +86,7 @@         utf8-string,         vector,         hslogger,-        Diff,+        Diff ^>=0.4.0,         vector,         bytestring-encoding,         opentelemetry >=0.6.1,@@ -101,7 +101,7 @@         cryptohash-sha1 >=0.11.100 && <0.12,         hie-bios >= 0.7.1 && < 0.8.0,         implicit-hie-cradle >= 0.3.0.2 && < 0.4,-        base16-bytestring >=0.1.1 && <0.2+        base16-bytestring >=0.1.1 && <1.1     if os(windows)       build-depends:         Win32@@ -112,9 +112,12 @@         cbits/getmodtime.c      default-extensions:+        ApplicativeDo         BangPatterns         DeriveFunctor         DeriveGeneric+        DeriveFoldable+        DeriveTraversable         FlexibleContexts         GeneralizedNewtypeDeriving         LambdaCase@@ -139,6 +142,7 @@         Control.Concurrent.Strict         Development.IDE         Development.IDE.Main+        Development.IDE.Core.Actions         Development.IDE.Core.Debouncer         Development.IDE.Core.FileStore         Development.IDE.Core.IdeConfiguration@@ -150,6 +154,7 @@         Development.IDE.Core.Service         Development.IDE.Core.Shake         Development.IDE.Core.Tracing+        Development.IDE.Core.UseStale         Development.IDE.GHC.Compat         Development.IDE.Core.Compile         Development.IDE.GHC.Error@@ -284,7 +289,8 @@         optparse-applicative,         shake,         text,-        unordered-containers+        unordered-containers,+        aeson-pretty     other-modules:         Arguments         Paths_ghcide@@ -316,6 +322,7 @@         implicit-hie:gen-hie     build-depends:         aeson,+        async,         base,         binary,         bytestring,@@ -340,12 +347,13 @@         hls-plugin-api,         network-uri,         lens,-        lsp-test == 0.13.0.0,+        lsp-test == 0.14.0.0,         optparse-applicative,         process,         QuickCheck,         quickcheck-instances,         rope-utf16-splay,+        regex-tdfa ^>= 1.3.1,         safe,         safe-exceptions,         shake,@@ -397,7 +405,7 @@         extra,         filepath,         ghcide,-        lsp-test == 0.13.0.0,+        lsp-test == 0.14.0.0,         optparse-applicative,         process,         safe-exceptions,

@@ -83,6 +83,7 @@  import           Control.Concurrent.STM               (atomically) import           Control.Concurrent.STM.TQueue+import qualified Data.HashSet                         as Set import           Database.SQLite.Simple import           HIE.Bios.Cradle                      (yamlConfig) import           HieDb.Create@@ -247,10 +248,10 @@                 found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations                 return (targetTarget, found)           modifyVarIO' knownTargetsVar $ traverseHashed $ \known -> do-            let known' = HM.unionWith (<>) known $ HM.fromList knownTargets+            let known' = HM.unionWith (<>) known $ HM.fromList $ map (second Set.fromList) knownTargets             when (known /= known') $                 logDebug logger $ "Known files updated: " <>-                    T.pack(show $ (HM.map . map) fromNormalizedFilePath known')+                    T.pack(show $ (HM.map . Set.map) fromNormalizedFilePath known')             pure known'      -- Create a new HscEnv from a hieYaml root and a set of options

@@ -6,6 +6,11 @@  ) where +import           Development.IDE.Core.Actions          as X (getAtPoint,+                                                             getDefinition,+                                                             getTypeDefinition,+                                                             useE, useNoFileE,+                                                             usesE) import           Development.IDE.Core.FileExists       as X (getFileExists) import           Development.IDE.Core.FileStore        as X (getFileContents) import           Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),@@ -13,11 +18,8 @@ import           Development.IDE.Core.OfInterest       as X (getFilesOfInterest) import           Development.IDE.Core.RuleTypes        as X import           Development.IDE.Core.Rules            as X (IsHiFileStable (..),-                                                             getAtPoint,                                                              getClientConfigAction,-                                                             getDefinition,-                                                             getParsedModule,-                                                             getTypeDefinition)+                                                             getParsedModule) import           Development.IDE.Core.Service          as X (runAction) import           Development.IDE.Core.Shake            as X (FastResult (..),                                                              IdeAction (..),

@@ -0,0 +1,127 @@+{-# LANGUAGE NoApplicativeDo #-}+{-# LANGUAGE TypeFamilies    #-}+module Development.IDE.Core.Actions+( getAtPoint+, getDefinition+, getTypeDefinition+, highlightAtPoint+, refsAtPoint+, useE+, useNoFileE+, usesE+, workspaceSymbols+) where++import           Control.Monad.Reader+import           Control.Monad.Trans.Maybe+import qualified Data.HashMap.Strict                  as HM+import           Data.Maybe+import qualified Data.Text                            as T+import           Data.Tuple.Extra+import           Development.IDE.Core.OfInterest+import           Development.IDE.Core.PositionMapping+import           Development.IDE.Core.RuleTypes+import           Development.IDE.Core.Service+import           Development.IDE.Core.Shake+import           Development.IDE.GHC.Compat           hiding (TargetFile,+                                                       TargetModule,+                                                       parseModule,+                                                       typecheckModule,+                                                       writeHieFile)+import qualified Development.IDE.Spans.AtPoint        as AtPoint+import           Development.IDE.Types.Location+import           Development.Shake                    hiding (Diagnostic)+import qualified HieDb+import           Language.LSP.Types                   (DocumentHighlight (..),+                                                       SymbolInformation (..))+++-- | Eventually this will lookup/generate URIs for files in dependencies, but not in the+-- project. Right now, this is just a stub.+lookupMod+  :: HieDbWriter -- ^ access the database+  -> FilePath -- ^ The `.hie` file we got from the database+  -> ModuleName+  -> UnitId+  -> Bool -- ^ Is this file a boot file?+  -> MaybeT IdeAction Uri+lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing+++-- IMPORTANT NOTE : make sure all rules `useE`d by these have a "Persistent Stale" rule defined,+-- so we can quickly answer as soon as the IDE is opened+-- Even if we don't have persistent information on disk for these rules, the persistent rule+-- should just return an empty result+-- It is imperative that the result of the persistent rule succeed in such a case, or we will+-- block waiting for the rule to be properly computed.++-- | Try to get hover text for the name under point.+getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [T.Text]))+getAtPoint file pos = runMaybeT $ do+  ide <- ask+  opts <- liftIO $ getIdeOptionsIO ide++  (hf, mapping) <- useE GetHieAst file+  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file)++  !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)+  MaybeT $ pure $ fmap (first (toCurrentRange mapping =<<)) $ AtPoint.atPoint opts hf dkMap pos'++toCurrentLocations :: PositionMapping -> [Location] -> [Location]+toCurrentLocations mapping = mapMaybe go+  where+    go (Location uri range) = Location uri <$> toCurrentRange mapping range++-- | useE is useful to implement functions that aren’t rules but need shortcircuiting+-- e.g. getDefinition.+useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)+useE k = MaybeT . useWithStaleFast k++useNoFileE :: IdeRule k v => IdeState -> k -> MaybeT IdeAction v+useNoFileE _ide k = fst <$> useE k emptyFilePath++usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT IdeAction [(v,PositionMapping)]+usesE k = MaybeT . fmap sequence . mapM (useWithStaleFast k)++-- | Goto Definition.+getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])+getDefinition file pos = runMaybeT $ do+    ide <- ask+    opts <- liftIO $ getIdeOptionsIO ide+    (HAR _ hf _ _ _, mapping) <- useE GetHieAst file+    (ImportMap imports, _) <- useE GetImportMap file+    !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos)+    hiedb <- lift $ asks hiedb+    dbWriter <- lift $ asks hiedbWriter+    toCurrentLocations mapping <$> AtPoint.gotoDefinition hiedb (lookupMod dbWriter) opts imports hf pos'++getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])+getTypeDefinition file pos = runMaybeT $ do+    ide <- ask+    opts <- liftIO $ getIdeOptionsIO ide+    (hf, mapping) <- useE GetHieAst file+    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)+    hiedb <- lift $ asks hiedb+    dbWriter <- lift $ asks hiedbWriter+    toCurrentLocations mapping <$> AtPoint.gotoTypeDefinition hiedb (lookupMod dbWriter) opts hf pos'++highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])+highlightAtPoint file pos = runMaybeT $ do+    (HAR _ hf rf _ _,mapping) <- useE GetHieAst file+    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)+    let toCurrentHighlight (DocumentHighlight range t) = flip DocumentHighlight t <$> toCurrentRange mapping range+    mapMaybe toCurrentHighlight <$>AtPoint.documentHighlight hf rf pos'++-- Refs are not an IDE action, so it is OK to be slow and (more) accurate+refsAtPoint :: NormalizedFilePath -> Position -> Action [Location]+refsAtPoint file pos = do+    ShakeExtras{hiedb} <- getShakeExtras+    fs <- HM.keys <$> getFilesOfInterest+    asts <- HM.fromList . mapMaybe sequence . zip fs <$> usesWithStale GetHieAst fs+    AtPoint.referencesAtPoint hiedb file pos (AtPoint.FOIReferences asts)++workspaceSymbols :: T.Text -> IdeAction (Maybe [SymbolInformation])+workspaceSymbols query = runMaybeT $ do+  hiedb <- lift $ asks hiedb+  res <- liftIO $ HieDb.searchDef hiedb $ T.unpack query+  pure $ mapMaybe AtPoint.defRowToSymbolInfo res

@@ -507,7 +507,9 @@ -- can just increment the 'indexCompleted' TVar and exit. -- indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Fingerprint -> Compat.HieFile -> IO ()-indexHieFile se mod_summary srcPath hash hf = atomically $ do+indexHieFile se mod_summary srcPath hash hf = do+ IdeOptions{optProgressStyle} <- getIdeOptionsIO se+ atomically $ do   pending <- readTVar indexPending   case HashMap.lookup srcPath pending of     Just pendingHash | pendingHash == hash -> pure () -- An index is already scheduled@@ -523,7 +525,7 @@             -- If the hash in the pending list doesn't match the current hash, then skip             Just pendingHash -> pendingHash /= hash         unless newerScheduled $ do-          pre+          pre optProgressStyle           addRefsFromLoaded db targetPath (RealFile $ fromNormalizedFilePath srcPath) hash hf           post   where@@ -532,7 +534,7 @@     HieDbWriter{..} = hiedbWriter se      -- Get a progress token to report progress and update it for the current file-    pre = do+    pre style = do       tok <- modifyVar indexProgressToken $ fmap dupe . \case         x@(Just _) -> pure x         -- Create a token if we don't already have one@@ -545,7 +547,7 @@               _ <- LSP.sendRequest LSP.SWindowWorkDoneProgressCreate (LSP.WorkDoneProgressCreateParams u) (const $ pure ())               LSP.sendNotification LSP.SProgress $ LSP.ProgressParams u $                 LSP.Begin $ LSP.WorkDoneProgressBeginParams-                  { _title = "Indexing references from:"+                  { _title = "Indexing"                   , _cancellable = Nothing                   , _message = Nothing                   , _percentage = Nothing@@ -557,15 +559,26 @@         remaining <- HashMap.size <$> readTVar indexPending         pure (done, remaining) -      let progress = " (" <> T.pack (show done) <> "/" <> T.pack (show $ done + remaining) <> ")..."-       whenJust (lspEnv se) $ \env -> whenJust tok $ \tok -> LSP.runLspT env $         LSP.sendNotification LSP.SProgress $ LSP.ProgressParams tok $-          LSP.Report $ LSP.WorkDoneProgressReportParams-            { _cancellable = Nothing-            , _message = Just $ T.pack (fromNormalizedFilePath srcPath) <> progress-            , _percentage = Nothing-            }+          LSP.Report $+            case style of+                Percentage -> LSP.WorkDoneProgressReportParams+                    { _cancellable = Nothing+                    , _message = Nothing+                    , _percentage = Just (100 * fromIntegral done / fromIntegral (done + remaining) )+                    }+                Explicit -> LSP.WorkDoneProgressReportParams+                    { _cancellable = Nothing+                    , _message = Just $+                        T.pack " (" <> T.pack (show done) <> "/" <> T.pack (show $ done + remaining) <> ")..."+                    , _percentage = Nothing+                    }+                NoProgress -> LSP.WorkDoneProgressReportParams+                  { _cancellable = Nothing+                  , _message = Nothing+                  , _percentage = Nothing+                  }      -- Report the progress once we are done indexing this file     post = do

@@ -67,6 +67,7 @@  import qualified Data.Binary                                  as B import qualified Data.ByteString.Lazy                         as LBS+import           Development.IDE.Core.IdeConfiguration        (isWorkspaceFile) import           Language.LSP.Server                          hiding                                                               (getVirtualFile) import qualified Language.LSP.Server                          as LSP@@ -127,16 +128,23 @@         let file' = fromNormalizedFilePath file         let wrap time@(l,s) = (Just $ LBS.toStrict $ B.encode time, ([], Just $ ModificationTime l s))         mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file-        -- we use 'getVirtualFile' to discriminate FOIs so make that-        -- dependency explicit by using the IsFileOfInterest rule-        _ <- use_ IsFileOfInterest file         case mbVirtual of             Just (virtualFileVersion -> ver) -> do                 alwaysRerun                 pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver))             Nothing -> do                 isWF <- isWatched file-                unless (isWF || isInterface file) alwaysRerun+                if isWF+                    then -- the file is watched so we can rely on FileWatched notifications,+                         -- but also need a dependency on IsFileOfInterest to reinstall+                         -- alwaysRerun when the file becomes VFS+                        void (use_ IsFileOfInterest file)+                    else if isInterface file+                        then -- interface files are tracked specially using the closed world assumption+                            pure ()+                        else -- in all other cases we will need to freshly check the file system+                            alwaysRerun+                 liftIO $ fmap wrap (getModTime file')                     `catch` \(e :: IOException) -> do                         let err | isDoesNotExistError e = "File does not exist: " ++ file'

@@ -98,7 +98,7 @@     liftIO $ progressUpdate KickStarted      -- Update the exports map for FOIs-    (results, ()) <- par (uses GenerateCore files) (void $ uses GetHieAst files)+    results <- uses GenerateCore files <* uses GetHieAst files      -- Update the exports map for non FOIs     -- We can skip this if checkProject is True, assuming they never change under our feet.

@@ -11,6 +11,7 @@   , PositionDelta(..)   , addDelta   , idDelta+  , composeDelta   , mkDelta   , toCurrentRange   , fromCurrentRange

@@ -18,21 +18,16 @@     priorityTypeCheck,     priorityGenerateCore,     priorityFilesOfInterest,-    runAction, useE, useNoFileE, usesE,+    runAction,     toIdeResult,     defineNoFile,     defineEarlyCutOffNoFile,     mainRule,-    getAtPoint,-    getDefinition,-    getTypeDefinition,-    highlightAtPoint,-    refsAtPoint,-    workspaceSymbols,     getDependencies,     getParsedModule,     getParsedModuleWithComments,     getClientConfigAction,+    usePropertyAction,     -- * Rules     CompiledLinkables(..),     IsHiFileStable(..),@@ -64,32 +59,51 @@     typeCheckRuleDefinition,     ) where -import           Fingerprint-+import           Control.Concurrent.Async                     (concurrently)+import           Control.Concurrent.Strict+import           Control.Exception.Safe import           Control.Monad.Extra-import           Control.Monad.Trans.Class+import           Control.Monad.Reader+import           Control.Monad.State+import           Control.Monad.Trans.Except                   (ExceptT, except,+                                                               runExceptT) import           Control.Monad.Trans.Maybe import           Data.Aeson                                   (Result (Success),                                                                toJSON)+import qualified Data.Aeson.Types                             as A import           Data.Binary                                  hiding (get, put)+import qualified Data.Binary                                  as B import qualified Data.ByteString                              as BS+import           Data.ByteString.Encoding                     as T+import qualified Data.ByteString.Lazy                         as LBS+import           Data.Coerce import           Data.Foldable+import qualified Data.HashMap.Strict                          as HM+import qualified Data.HashSet                                 as HashSet+import           Data.Hashable+import           Data.IORef import           Data.IntMap.Strict                           (IntMap) import qualified Data.IntMap.Strict                           as IntMap import           Data.List import qualified Data.Map                                     as M import           Data.Maybe+import qualified Data.Rope.UTF16                              as Rope import qualified Data.Set                                     as Set import qualified Data.Text                                    as T import qualified Data.Text.Encoding                           as T+import           Data.Time                                    (UTCTime (..)) import           Data.Tuple.Extra import           Development.IDE.Core.Compile import           Development.IDE.Core.FileExists import           Development.IDE.Core.FileStore               (getFileContents,-                                                               modificationTime, resetInterfaceStore)+                                                               modificationTime,+                                                               resetInterfaceStore)+import           Development.IDE.Core.IdeConfiguration import           Development.IDE.Core.OfInterest import           Development.IDE.Core.PositionMapping import           Development.IDE.Core.RuleTypes+import           Development.IDE.Core.Service+import           Development.IDE.Core.Shake import           Development.IDE.GHC.Compat                   hiding                                                               (TargetFile,                                                                TargetModule,@@ -101,57 +115,37 @@ import           Development.IDE.GHC.Util import           Development.IDE.Import.DependencyInformation import           Development.IDE.Import.FindImports+import qualified Development.IDE.Spans.AtPoint                as AtPoint import           Development.IDE.Spans.Documentation import           Development.IDE.Spans.LocalBindings import           Development.IDE.Types.Diagnostics            as Diag+import           Development.IDE.Types.HscEnvEq import           Development.IDE.Types.Location import qualified Development.IDE.Types.Logger                 as L import           Development.IDE.Types.Options import           Development.Shake                            hiding                                                               (Diagnostic)-import qualified Language.LSP.Server                          as LSP-import           Language.LSP.Types                           (DocumentHighlight (..),-                                                               SMethod (SCustomMethod),-                                                               SymbolInformation (..))-import           Language.LSP.VFS-+import           Development.Shake.Classes                    hiding (get, put)+import           Fingerprint import           GHC.Generics                                 (Generic)+import           GHC.IO.Encoding import qualified GHC.LanguageExtensions                       as LangExt+import qualified HieDb import           HscTypes                                     hiding                                                               (TargetFile,                                                                TargetModule)--import           Control.Concurrent.Async                     (concurrently)-import           Control.Exception.Safe-import           Control.Monad.Reader-import           Control.Monad.Trans.Except                   (ExceptT, except,-                                                               runExceptT)-import           Development.IDE.Core.IdeConfiguration-import           Development.IDE.Core.Service-import           Development.IDE.Core.Shake-import qualified Development.IDE.Spans.AtPoint                as AtPoint-import           Development.IDE.Types.HscEnvEq-import           Development.Shake.Classes                    hiding (get, put)--import           Control.Concurrent.Strict-import           Control.Monad.State-import           Data.ByteString.Encoding                     as T-import           Data.Coerce-import qualified Data.HashMap.Strict                          as HM-import qualified Data.HashSet                                 as HashSet-import           Data.Hashable-import           Data.IORef-import qualified Data.Rope.UTF16                              as Rope-import           Data.Time                                    (UTCTime (..))-import           GHC.IO.Encoding+import           Ide.Plugin.Config+import qualified Language.LSP.Server                          as LSP+import           Language.LSP.Types                           (SMethod (SCustomMethod))+import           Language.LSP.VFS import           Module import           TcRnMonad                                    (tcg_dependent_files) -import qualified Data.Aeson.Types                             as A-import qualified HieDb-import           Ide.Plugin.Config-import qualified Data.ByteString.Lazy as LBS-import qualified Data.Binary as B+import           Ide.Plugin.Properties (HasProperty, KeyNameProxy, Properties, ToHsType, useProperty)+import           Ide.Types (PluginId)+import           Data.Default (def)+import           Ide.PluginUtils (configForPlugin)+import           Control.Applicative  -- | This is useful for rules to convert rules that can only produce errors or -- a result into the more general IdeResult type that supports producing@@ -159,17 +153,6 @@ toIdeResult :: Either [FileDiagnostic] v -> IdeResult v toIdeResult = either (, Nothing) (([],) . Just) --- | useE is useful to implement functions that aren’t rules but need shortcircuiting--- e.g. getDefinition.-useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)-useE k = MaybeT . useWithStaleFast k--useNoFileE :: IdeRule k v => IdeState -> k -> MaybeT IdeAction v-useNoFileE _ide k = fst <$> useE k emptyFilePath--usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT IdeAction [(v,PositionMapping)]-usesE k = MaybeT . fmap sequence . mapM (useWithStaleFast k)- defineNoFile :: IdeRule k v => (k -> Action v) -> Rules () defineNoFile f = defineNoDiagnostics $ \k file -> do     if file == emptyFilePath then do res <- f k; return (Just res) else@@ -181,91 +164,8 @@         fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file"  --------------------------------------------------------------- Core IDE features----------------------------------------------------------------- IMPORTANT NOTE : make sure all rules `useE`d by these have a "Persistent Stale" rule defined,--- so we can quickly answer as soon as the IDE is opened--- Even if we don't have persistent information on disk for these rules, the persistent rule--- should just return an empty result--- It is imperative that the result of the persistent rule succeed in such a case, or we will--- block waiting for the rule to be properly computed.---- | Try to get hover text for the name under point.-getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [T.Text]))-getAtPoint file pos = runMaybeT $ do-  ide <- ask-  opts <- liftIO $ getIdeOptionsIO ide--  (hf, mapping) <- useE GetHieAst file-  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file)--  !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)-  MaybeT $ pure $ fmap (first (toCurrentRange mapping =<<)) $ AtPoint.atPoint opts hf dkMap pos'--toCurrentLocations :: PositionMapping -> [Location] -> [Location]-toCurrentLocations mapping = mapMaybe go-  where-    go (Location uri range) = Location uri <$> toCurrentRange mapping range---- | Goto Definition.-getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])-getDefinition file pos = runMaybeT $ do-    ide <- ask-    opts <- liftIO $ getIdeOptionsIO ide-    (HAR _ hf _ _ _, mapping) <- useE GetHieAst file-    (ImportMap imports, _) <- useE GetImportMap file-    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)-    hiedb <- lift $ asks hiedb-    dbWriter <- lift $ asks hiedbWriter-    toCurrentLocations mapping <$> AtPoint.gotoDefinition hiedb (lookupMod dbWriter) opts imports hf pos'--getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])-getTypeDefinition file pos = runMaybeT $ do-    ide <- ask-    opts <- liftIO $ getIdeOptionsIO ide-    (hf, mapping) <- useE GetHieAst file-    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)-    hiedb <- lift $ asks hiedb-    dbWriter <- lift $ asks hiedbWriter-    toCurrentLocations mapping <$> AtPoint.gotoTypeDefinition hiedb (lookupMod dbWriter) opts hf pos'--highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])-highlightAtPoint file pos = runMaybeT $ do-    (HAR _ hf rf _ _,mapping) <- useE GetHieAst file-    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)-    let toCurrentHighlight (DocumentHighlight range t) = flip DocumentHighlight t <$> toCurrentRange mapping range-    mapMaybe toCurrentHighlight <$>AtPoint.documentHighlight hf rf pos'---- Refs are not an IDE action, so it is OK to be slow and (more) accurate-refsAtPoint :: NormalizedFilePath -> Position -> Action [Location]-refsAtPoint file pos = do-    ShakeExtras{hiedb} <- getShakeExtras-    fs <- HM.keys <$> getFilesOfInterest-    asts <- HM.fromList . mapMaybe sequence . zip fs <$> usesWithStale GetHieAst fs-    AtPoint.referencesAtPoint hiedb file pos (AtPoint.FOIReferences asts)--workspaceSymbols :: T.Text -> IdeAction (Maybe [SymbolInformation])-workspaceSymbols query = runMaybeT $ do-  hiedb <- lift $ asks hiedb-  res <- liftIO $ HieDb.searchDef hiedb $ T.unpack query-  pure $ mapMaybe AtPoint.defRowToSymbolInfo res-------------------------------------------------------------- -- Exposed API ---------------------------------------------------------------- | Eventually this will lookup/generate URIs for files in dependencies, but not in the--- project. Right now, this is just a stub.-lookupMod-  :: HieDbWriter -- ^ access the database-  -> FilePath -- ^ The `.hie` file we got from the database-  -> ModuleName-  -> UnitId-  -> Bool -- ^ Is this file a boot file?-  -> MaybeT IdeAction Uri-lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing- -- | Get all transitive file dependencies of a given module. -- Does not include the file itself. getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])@@ -398,7 +298,7 @@     let fp = fromNormalizedFilePath file     (diag, res) <- parseModule opt packageState fp ms     case res of-        Nothing -> pure (diag, Nothing)+        Nothing   -> pure (diag, Nothing)         Just modu -> pure (diag, Just modu)  getLocatedImportsRule :: Rules ()@@ -877,8 +777,8 @@                            else SourceUnmodified     return (Just (summarize sourceModified), Just sourceModified)   where-      summarize SourceModified = BS.singleton 1-      summarize SourceUnmodified = BS.singleton 2+      summarize SourceModified            = BS.singleton 1+      summarize SourceUnmodified          = BS.singleton 2       summarize SourceUnmodifiedAndStable = BS.singleton 3  getModSummaryRule :: Rules ()@@ -1046,6 +946,19 @@     Just (Success c) -> return c     _                -> return defValue +usePropertyAction ::+  (HasProperty s k t r) =>+  KeyNameProxy s ->+  PluginId ->+  Properties r ->+  Action (ToHsType t)+usePropertyAction kn plId p = do+  config <- getClientConfigAction def+  let pluginConfig = configForPlugin config plId+  pure $ useProperty kn p $ plcConfig pluginConfig++-- ---------------------------------------------------------------------+ -- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType) getLinkableType f = use_ NeedsCompilation f@@ -1070,8 +983,8 @@         -- again, this time keeping the object code.         -- A file needs to be compiled if any file that depends on it uses TemplateHaskell or needs to be compiled         ms <- msrModSummary . fst <$> useWithStale_ GetModSummaryWithoutTimestamps file-        (modsums,needsComps) <--            par (map (fmap (msrModSummary . fst)) <$> usesWithStale GetModSummaryWithoutTimestamps revdeps)+        (modsums,needsComps) <- liftA2+            (,) (map (fmap (msrModSummary . fst)) <$> usesWithStale GetModSummaryWithoutTimestamps revdeps)                 (uses NeedsCompilation revdeps)         pure $ computeLinkableType ms modsums (map join needsComps) 

@@ -50,7 +50,7 @@     getIdeOptions,     getIdeOptionsIO,     GlobalIdeOptions(..),-    getClientConfig,+    HLS.getClientConfig,     getPluginConfig,     garbageCollect,     knownTargets,@@ -230,14 +230,10 @@     Just x <- getShakeExtraRules @ShakeExtras     return x -getClientConfig :: LSP.MonadLsp Config m => ShakeExtras -> m Config-getClientConfig ShakeExtras { defaultConfig } =-    fromMaybe defaultConfig <$> HLS.getClientConfig- getPluginConfig-    :: LSP.MonadLsp Config m => ShakeExtras -> PluginId -> m PluginConfig-getPluginConfig extras plugin = do-    config <- getClientConfig extras+    :: LSP.MonadLsp Config m => PluginId -> m PluginConfig+getPluginConfig plugin = do+    config <- HLS.getClientConfig     return $ HLS.configForPlugin config plugin  -- | Register a function that will be called to get the "stale" result of a rule, possibly from disk@@ -503,7 +499,7 @@         let hiedbWriter = HieDbWriter{..}         progressAsync <- async $             when reportProgress $-                progressThread mostRecentProgressEvent inProgress+                progressThread optProgressStyle mostRecentProgressEvent inProgress         exportsMap <- newVar mempty          actionQueue <- newQueue@@ -521,7 +517,10 @@     shakeDatabaseProfile <- shakeDatabaseProfileIO shakeProfileDir     let ideState = IdeState{..} -    IdeOptions{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled } <- getIdeOptionsIO shakeExtras+    IdeOptions+        { optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled+        , optProgressStyle+        } <- getIdeOptionsIO shakeExtras     startTelemetry otProfilingEnabled logger $ state shakeExtras      return ideState@@ -532,7 +531,7 @@         -- And two transitions, modelled by 'ProgressEvent':         --   1. KickCompleted - transitions from Reporting into Idle         --   2. KickStarted - transitions from Idle into Reporting-        progressThread mostRecentProgressEvent inProgress = progressLoopIdle+        progressThread style mostRecentProgressEvent inProgress = progressLoopIdle           where             progressLoopIdle = do                 atomically $ do@@ -564,7 +563,7 @@                 bracket_                   (start u)                   (stop u)-                  (loop u Nothing)+                  (loop u 0)                 where                     start id = LSP.sendNotification LSP.SProgress $                         LSP.ProgressParams@@ -589,16 +588,27 @@                         current <- liftIO $ readVar inProgress                         let done = length $ filter (== 0) $ HMap.elems current                         let todo = HMap.size current-                        let next = Just $ T.pack $ show done <> "/" <> show todo+                        let next = 100 * fromIntegral done / fromIntegral todo                         when (next /= prev) $                           LSP.sendNotification LSP.SProgress $                           LSP.ProgressParams                               { _token = id-                              , _value = LSP.Report $ LSP.WorkDoneProgressReportParams-                                { _cancellable = Nothing-                                , _message = next-                                , _percentage = Nothing-                                }+                              , _value = LSP.Report $ case style of+                                  Explicit -> LSP.WorkDoneProgressReportParams+                                    { _cancellable = Nothing+                                    , _message = Just $ T.pack $ show done <> "/" <> show todo+                                    , _percentage = Nothing+                                    }+                                  Percentage -> LSP.WorkDoneProgressReportParams+                                    { _cancellable = Nothing+                                    , _message = Nothing+                                    , _percentage = Just next+                                    }+                                  NoProgress -> LSP.WorkDoneProgressReportParams+                                    { _cancellable = Nothing+                                    , _message = Nothing+                                    , _percentage = Nothing+                                    }                               }                         loop id next @@ -828,12 +838,14 @@         Nothing -> liftIO $ throwIO $ BadDependency (show key)         Just v  -> return v -newtype IdeAction a = IdeAction { runIdeActionT  :: (ReaderT ShakeExtras IO) a }-    deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad)- -- | IdeActions are used when we want to return a result immediately, even if it -- is stale Useful for UI actions like hover, completion where we don't want to -- block.+--+-- Run via 'runIdeAction'.+newtype IdeAction a = IdeAction { runIdeActionT  :: (ReaderT ShakeExtras IO) a }+    deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad)+ runIdeAction :: String -> ShakeExtras -> IdeAction a -> IO a runIdeAction _herald s i = runReaderT (runIdeActionT i) s 

@@ -1,3 +1,4 @@+{-# LANGUAGE NoApplicativeDo #-} {-# LANGUAGE CPP #-} #include "ghc-api-version.h" module Development.IDE.Core.Tracing@@ -6,7 +7,9 @@     , startTelemetry     , measureMemory     , getInstrumentCached-    ,otTracedProvider,otSetUri)+    , otTracedProvider+    , otSetUri+    ) where  import           Control.Concurrent.Async       (Async, async)@@ -26,6 +29,7 @@                                                  readIORef, writeIORef) import           Data.String                    (IsString (fromString)) import           Data.Text.Encoding             (encodeUtf8)+import           Debug.Trace.Flags              (userTracingEnabled) import           Development.IDE.Core.RuleTypes (GhcSession (GhcSession),                                                  GhcSessionDeps (GhcSessionDeps),                                                  GhcSessionIO (GhcSessionIO))@@ -36,19 +40,17 @@                                                  Values) import           Development.Shake              (Action, actionBracket) import           Foreign.Storable               (Storable (sizeOf))-import           GHC.RTS.Flags import           HeapSize                       (recursiveSize, runHeapsize) import           Ide.PluginUtils                (installSigUsr1Handler) import           Ide.Types                      (PluginId (..)) import           Language.LSP.Types             (NormalizedFilePath,                                                  fromNormalizedFilePath) import           Numeric.Natural                (Natural)-import           OpenTelemetry.Eventlog         (Instrument, SpanInFlight,+import           OpenTelemetry.Eventlog         (Instrument, SpanInFlight (..),                                                  Synchronicity (Asynchronous),                                                  addEvent, beginSpan, endSpan,                                                  mkValueObserver, observe,                                                  setTag, withSpan, withSpan_)-import           System.IO.Unsafe               (unsafePerformIO)  -- | Trace a handler using OpenTelemetry. Adds various useful info into tags in the OpenTelemetry span. otTracedHandler@@ -57,27 +59,20 @@     -> String -- ^ Message label     -> (SpanInFlight -> m a)     -> m a-otTracedHandler requestType label act =-  let !name =-        if null label-          then requestType-          else requestType <> ":" <> show label-   -- Add an event so all requests can be quickly seen in the viewer without searching-   in do-     runInIO <- askRunInIO-     liftIO $ withSpan (fromString name) (\sp -> addEvent sp "" (fromString $ name <> " received") >> runInIO (act sp))+otTracedHandler requestType label act+  | userTracingEnabled = do+    let !name =+            if null label+            then requestType+            else requestType <> ":" <> show label+    -- Add an event so all requests can be quickly seen in the viewer without searching+    runInIO <- askRunInIO+    liftIO $ withSpan (fromString name) (\sp -> addEvent sp "" (fromString $ name <> " received") >> runInIO (act sp))+  | otherwise = act (SpanInFlight 0)  otSetUri :: SpanInFlight -> Uri -> IO () otSetUri sp (Uri t) = setTag sp "uri" (encodeUtf8 t) -{-# NOINLINE isTracingEnabled #-}-isTracingEnabled :: Bool-isTracingEnabled = unsafePerformIO $ do-    flags <- getTraceFlags-    case tracing flags of-        TraceNone -> return False-        _         -> return True- -- | Trace a Shake action using opentelemetry. otTracedAction     :: Show k@@ -87,7 +82,7 @@     -> Action a -- ^ The action     -> Action a otTracedAction key file success act-  | isTracingEnabled =+  | userTracingEnabled =     actionBracket         (do             sp <- beginSpan (fromString (show key))@@ -106,11 +101,13 @@ #else otTracedProvider :: MonadUnliftIO m => PluginId -> String -> m a -> m a #endif-otTracedProvider (PluginId pluginName) provider act = do-  runInIO <- askRunInIO-  liftIO $ withSpan (provider <> " provider") $ \sp -> do-    setTag sp "plugin" (encodeUtf8 pluginName)-    runInIO act+otTracedProvider (PluginId pluginName) provider act+  | userTracingEnabled = do+    runInIO <- askRunInIO+    liftIO $ withSpan (provider <> " provider") $ \sp -> do+        setTag sp "plugin" (encodeUtf8 pluginName)+        runInIO act+  | otherwise = act  startTelemetry :: Bool -> Logger -> Var Values -> IO () startTelemetry allTheTime logger stateRef = do

@@ -0,0 +1,158 @@+{-# LANGUAGE DerivingVia    #-}+{-# LANGUAGE GADTs          #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes     #-}++module Development.IDE.Core.UseStale+  ( Age(..)+  , Tracked+  , unTrack+  , PositionMap+  , TrackedStale (..)+  , untrackedStaleValue+  , unsafeMkStale+  , unsafeMkCurrent+  , unsafeCopyAge+  , MapAge (..)+  , dualPositionMap+  , useWithStale+  , useWithStale_+  ) where++import           Control.Arrow+import           Control.Category (Category)+import qualified Control.Category as C+import           Control.DeepSeq (NFData)+import           Data.Aeson+import           Data.Coerce (coerce)+import           Data.Functor ((<&>))+import           Data.Functor.Identity (Identity(Identity))+import           Data.Kind (Type)+import           Data.String (fromString)+import           Development.IDE (NormalizedFilePath, IdeRule, Action, Range, rangeToRealSrcSpan, realSrcSpanToRange)+import qualified Development.IDE.Core.PositionMapping as P+import qualified Development.IDE.Core.Shake as IDE+import qualified FastString as FS+import           SrcLoc+++------------------------------------------------------------------------------+-- | A data kind for 'Tracked'.+data Age = Current | Stale Type+++------------------------------------------------------------------------------+-- | Some value, tagged with its age. All 'Current' ages are considered to be+-- the same thing, but 'Stale' values are protected by an untouchable variable+-- to ensure they can't be unified.+newtype Tracked (age :: Age) a  = UnsafeTracked+  { unTrack :: a+  }+  deriving stock (Functor, Foldable, Traversable)+  deriving newtype (Eq, Ord, Show, Read, ToJSON, FromJSON, NFData)+  deriving (Applicative, Monad) via Identity+++------------------------------------------------------------------------------+-- | Like 'P.PositionMapping', but with annotated ages for how 'Tracked' values+-- change. Use the 'Category' instance to compose 'PositionMapping's in order+-- to transform between values of different stale ages.+newtype PositionMap (from :: Age) (to :: Age) = PositionMap+  { getPositionMapping :: P.PositionMapping+  }++instance Category PositionMap where+  id  = coerce P.zeroMapping+  (.) = coerce P.composeDelta+++------------------------------------------------------------------------------+-- | Get a 'PositionMap' that runs in the opposite direction.+dualPositionMap :: PositionMap from to -> PositionMap to from+dualPositionMap (PositionMap (P.PositionMapping (P.PositionDelta from to))) =+  PositionMap $ P.PositionMapping $ P.PositionDelta to from+++------------------------------------------------------------------------------+-- | A pair containing a @'Tracked' 'Stale'@ value, as well as+-- a 'PositionMapping' that will fast-forward values to the current age.+data TrackedStale a where+  TrackedStale+      :: Tracked (Stale s) a+      -> PositionMap (Stale s) Current+      -> TrackedStale a++instance Functor TrackedStale where+  fmap f (TrackedStale t pm) = TrackedStale (fmap f t) pm+++untrackedStaleValue :: TrackedStale a -> a+untrackedStaleValue (TrackedStale ta _) = coerce ta+++------------------------------------------------------------------------------+-- | A class for which 'Tracked' values can be run across a 'PositionMapping'+-- to change their ages.+class MapAge a where+  {-# MINIMAL mapAgeFrom | mapAgeTo #-}+  mapAgeFrom :: PositionMap from to -> Tracked to   a -> Maybe (Tracked from a)+  mapAgeFrom = mapAgeTo . dualPositionMap++  mapAgeTo   :: PositionMap from to -> Tracked from a -> Maybe (Tracked to   a)+  mapAgeTo = mapAgeFrom . dualPositionMap+++instance MapAge Range where+  mapAgeFrom = coerce P.fromCurrentRange+  mapAgeTo   = coerce P.toCurrentRange+++instance MapAge RealSrcSpan where+  mapAgeFrom =+    invMapAge (\fs -> rangeToRealSrcSpan (fromString $ FS.unpackFS fs))+              (srcSpanFile &&& realSrcSpanToRange)+      .  mapAgeFrom+++------------------------------------------------------------------------------+-- | Helper function for deriving 'MapAge' for values in terms of other+-- instances.+invMapAge+    :: (c -> a -> b)+    -> (b -> (c, a))+    -> (Tracked from a -> Maybe (Tracked to a))+    -> Tracked from b+    -> Maybe (Tracked to b)+invMapAge to from f t =+  let (c, t') = unTrack $ fmap from t+   in fmap (fmap $ to c) $ f $ UnsafeTracked t'+++unsafeMkCurrent :: age ->  Tracked 'Current age+unsafeMkCurrent = coerce+++unsafeMkStale :: age -> Tracked (Stale s) age+unsafeMkStale = coerce+++unsafeCopyAge :: Tracked age a -> b -> Tracked age b+unsafeCopyAge _ = coerce+++-- | Request a Rule result, it not available return the last computed result, if any, which may be stale+useWithStale :: IdeRule k v+    => k -> NormalizedFilePath -> Action (Maybe (TrackedStale v))+useWithStale key file = do+  x <- IDE.useWithStale key file+  pure $ x <&> \(v, pm) ->+    TrackedStale (coerce v) (coerce pm)++-- | Request a Rule result, it not available return the last computed result which may be stale.+--   Errors out if none available.+useWithStale_ :: IdeRule k v+    => k -> NormalizedFilePath -> Action (TrackedStale v)+useWithStale_ key file = do+  (v, pm) <- IDE.useWithStale_ key file+  pure $ TrackedStale (coerce v) (coerce pm)+

@@ -13,6 +13,7 @@     ) where  import           Control.Monad.IO.Class+import           Development.IDE.Core.Actions import           Development.IDE.Core.Rules import           Development.IDE.Core.Shake import           Development.IDE.LSP.Server

@@ -12,9 +12,6 @@     ( runLanguageServer     ) where -import           Control.Concurrent.Extra              (newBarrier,-                                                        signalBarrier,-                                                        waitBarrier) import           Control.Concurrent.STM import           Control.Monad.Extra import           Control.Monad.IO.Class@@ -23,10 +20,8 @@ import           Data.Maybe import qualified Data.Set                              as Set import qualified Data.Text                             as T-import qualified Development.IDE.GHC.Util              as Ghcide import           Development.IDE.LSP.Server import           Development.IDE.Session               (runWithDb)-import           GHC.IO.Handle                         (hDuplicate) import           Ide.Types                             (traceWithSpan) import qualified Language.LSP.Server                   as LSP import           Language.LSP.Types@@ -41,7 +36,6 @@ import           Development.IDE.Core.Shake import           Development.IDE.Core.Tracing import           Development.IDE.LSP.HoverDefinition-import           Development.IDE.LSP.Notifications import           Development.IDE.Types.Logger  import           System.IO.Unsafe                      (unsafeInterleaveIO)@@ -49,32 +43,21 @@ runLanguageServer     :: forall config. (Show config)     => LSP.Options+    -> Handle -- input+    -> Handle -- output     -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project-    -> (IdeState -> Value -> IO (Either T.Text config))+    -> config+    -> (config -> Value -> Either T.Text config)     -> LSP.Handlers (ServerM config)     -> (LSP.LanguageContextEnv config -> VFSHandle -> Maybe FilePath -> HieDb -> IndexQueue -> IO IdeState)     -> IO ()-runLanguageServer options getHieDbLoc onConfigurationChange userHandlers getIdeState = do-    -- Move stdout to another file descriptor and duplicate stderr-    -- to stdout. This guards against stray prints from corrupting the JSON-RPC-    -- message stream.-    newStdout <- hDuplicate stdout-    stderr `Ghcide.hDuplicateTo'` stdout-    hSetBuffering stderr NoBuffering-    hSetBuffering stdout NoBuffering--    -- Print out a single space to assert that the above redirection works.-    -- This is interleaved with the logger, hence we just print a space here in-    -- order not to mess up the output too much. Verified that this breaks-    -- the language server tests without the redirection.-    putStr " " >> hFlush stdout+runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChange userHandlers getIdeState = do -    -- These barriers are signaled when the threads reading from these chans exit.-    -- This should not happen but if it does, we will make sure that the whole server-    -- dies and can be restarted instead of losing threads silently.-    clientMsgBarrier <- newBarrier+    -- This MVar becomes full when the server thread exits or we receive exit message from client.+    -- LSP loop will be canceled when it's full.+    clientMsgVar <- newEmptyMVar     -- Forcefully exit-    let exit = signalBarrier clientMsgBarrier ()+    let exit = void $ tryPutMVar clientMsgVar ()      -- The set of requests ids that we have received but not finished processing     pendingRequests <- newTVarIO Set.empty@@ -100,7 +83,6 @@     let ideHandlers = mconcat           [ setIdeHandlers           , userHandlers-          , setHandlersNotifications -- absolutely critical, join them with user notifications           ]      -- Send everything over a channel, since you need to wait until after initialise before@@ -117,9 +99,8 @@       let serverDefinition = LSP.ServerDefinition-            { LSP.onConfigurationChange = \v -> do-                (_chan, ide) <- ask-                liftIO $ onConfigurationChange ide v+            { LSP.onConfigurationChange = onConfigurationChange+            , LSP.defaultConfig = defaultConfig             , LSP.doInitialize = handleInit exit clearReqId waitForCancel clientMsgChan             , LSP.staticHandlers = asyncHandlers             , LSP.interpretHandler = \(env, st) -> LSP.Iso (LSP.runLspT env . flip runReaderT (clientMsgChan,st)) liftIO@@ -128,10 +109,10 @@      void $ waitAnyCancel =<< traverse async         [ void $ LSP.runServerWithHandles-            stdin-            newStdout+            inH+            outH             serverDefinition-        , void $ waitBarrier clientMsgBarrier+        , void $ readMVar clientMsgVar         ]      where@@ -156,7 +137,12 @@             logInfo (ideLogger ide) $ T.pack $ "Registering ide configuration: " <> show initConfig             registerIdeConfiguration (shakeExtras ide) initConfig -            _ <- flip forkFinally (const exitClientMsg) $ runWithDb dbLoc $ \hiedb hieChan -> do+            let handleServerException (Left e) = do+                    logError (ideLogger ide) $+                        T.pack $ "Fatal error in server thread: " <> show e+                    exitClientMsg+                handleServerException _ = pure ()+            _ <- flip forkFinally handleServerException $ runWithDb dbLoc $ \hiedb hieChan -> do               putMVar dbMVar (hiedb,hieChan)               forever $ do                 msg <- readChan clientMsgChan@@ -202,8 +188,9 @@ exitHandler :: IO () -> LSP.Handlers (ServerM c) exitHandler exit = LSP.notificationHandler SExit $ const $ do     (_, ide) <- ask+    liftIO $ logDebug (ideLogger ide) "Received exit message"     -- flush out the Shake session to record a Shake profile if applicable-    liftIO $ restartShakeSession (shakeExtras ide) []+    liftIO $ shakeShut ide     liftIO exit  modifyOptions :: LSP.Options -> LSP.Options

@@ -7,7 +7,8 @@ {-# LANGUAGE RankNTypes            #-}  module Development.IDE.LSP.Notifications-    ( setHandlersNotifications+    ( whenUriFile+    , descriptor     ) where  import qualified Language.LSP.Server                   as LSP@@ -18,7 +19,6 @@ import           Development.IDE.Core.IdeConfiguration import           Development.IDE.Core.Service import           Development.IDE.Core.Shake-import           Development.IDE.LSP.Server import           Development.IDE.Types.Location import           Development.IDE.Types.Logger import           Development.IDE.Types.Options@@ -37,15 +37,15 @@                                                         typecheckParents) import           Development.IDE.Core.OfInterest import           Ide.Plugin.Config                     (CheckParents (CheckOnClose))-+import           Ide.Types  whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath' -setHandlersNotifications :: LSP.Handlers (ServerM c)-setHandlersNotifications = mconcat-  [ notificationHandler LSP.STextDocumentDidOpen $-      \ide (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do+descriptor :: PluginId -> PluginDescriptor IdeState+descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = mconcat+  [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $+      \ide _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do       updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List [])       whenUriFile _uri $ \file -> do           -- We don't know if the file actually exists, or if the contents match those on disk@@ -54,23 +54,23 @@           setFileModified ide False file           logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri -  , notificationHandler LSP.STextDocumentDidChange $-      \ide (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do+  , mkPluginNotificationHandler LSP.STextDocumentDidChange $+      \ide _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do         updatePositionMapping ide identifier changes         whenUriFile _uri $ \file -> do           modifyFilesOfInterest ide (M.insert file Modified{firstOpen=False})           setFileModified ide False file         logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri -  , notificationHandler LSP.STextDocumentDidSave $-      \ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do+  , mkPluginNotificationHandler LSP.STextDocumentDidSave $+      \ide _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do         whenUriFile _uri $ \file -> do             modifyFilesOfInterest ide (M.insert file OnDisk)             setFileModified ide True file         logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri -  , notificationHandler LSP.STextDocumentDidClose $-        \ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do+  , mkPluginNotificationHandler LSP.STextDocumentDidClose $+        \ide _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do           whenUriFile _uri $ \file -> do               modifyFilesOfInterest ide (M.delete file)               -- Refresh all the files that depended on this@@ -78,8 +78,8 @@               when (checkParents >= CheckOnClose) $ typecheckParents ide file               logDebug (ideLogger ide) $ "Closed text document: " <> getUri _uri -  , notificationHandler LSP.SWorkspaceDidChangeWatchedFiles $-      \ide (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do+  , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWatchedFiles $+      \ide _ (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do         -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and         -- what we do with them         let msg = Text.pack $ show fileEvents@@ -88,22 +88,22 @@         resetFileStore ide fileEvents         setSomethingModified ide -  , notificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $-      \ide (DidChangeWorkspaceFoldersParams events) -> liftIO $ do+  , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $+      \ide _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do         let add       = S.union             substract = flip S.difference         modifyWorkspaceFolders ide           $ add       (foldMap (S.singleton . parseWorkspaceFolder) (_added   events))           . substract (foldMap (S.singleton . parseWorkspaceFolder) (_removed events)) -  , notificationHandler LSP.SWorkspaceDidChangeConfiguration $-      \ide (DidChangeConfigurationParams cfg) -> liftIO $ do+  , mkPluginNotificationHandler LSP.SWorkspaceDidChangeConfiguration $+      \ide _ (DidChangeConfigurationParams cfg) -> liftIO $ do         let msg = Text.pack $ show cfg         logDebug (ideLogger ide) $ "Configuration changed: " <> msg         modifyClientSettings ide (const $ Just cfg)         setSomethingModified ide -  , notificationHandler LSP.SInitialized $ \ide _ -> do+  , mkPluginNotificationHandler LSP.SInitialized $ \ide _ _ -> do       clientCapabilities <- LSP.getClientCapabilities       let watchSupported = case () of             _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities@@ -138,3 +138,4 @@         void $ LSP.sendRequest SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response       else liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling"   ]+    }

@@ -19,7 +19,7 @@ import           Development.IDE.Core.Rules import           Development.IDE.Core.Shake import           Development.IDE.GHC.Compat-import           Development.IDE.GHC.Error      (realSrcSpanToRange)+import           Development.IDE.GHC.Error      (realSrcSpanToRange, rangeToRealSrcSpan) import           Development.IDE.Types.Location import           Language.LSP.Server            (LspM) import           Language.LSP.Types@@ -69,7 +69,7 @@                        t  -> " " <> t                      )     , _detail = Just $ pprText fdInfo-    , _kind   = SkClass+    , _kind   = SkFunction     } documentSymbolForDecl (L (RealSrcSpan l) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))   = Just (defDocumentSymbol l :: DocumentSymbol)@@ -78,7 +78,7 @@                          "" -> ""                          t  -> " " <> t                        )-    , _kind     = SkClass+    , _kind     = SkInterface     , _detail   = Just "class"     , _children =       Just $ List@@ -183,12 +183,10 @@       mergeRanges xs = Range (minimum $ map _start xs) (maximum $ map _end xs)       importRange = mergeRanges $ map (_range :: DocumentSymbol -> Range) importSymbols     in-      Just (defDocumentSymbol empty :: DocumentSymbol)+      Just (defDocumentSymbol (rangeToRealSrcSpan "" importRange))           { _name = "imports"           , _kind = SkModule           , _children = Just (List importSymbols)-          , _range = importRange-          , _selectionRange = importRange           }  documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol@@ -213,6 +211,7 @@   _range          = realSrcSpanToRange l   _selectionRange = realSrcSpanToRange l   _children       = Nothing+  _tags           = Nothing  showRdrName :: RdrName -> Text showRdrName = pprText

@@ -1,4 +1,12 @@-module Development.IDE.Main (Arguments(..), defaultMain) where+{-# OPTIONS_GHC -Wno-orphans #-}+module Development.IDE.Main+(Arguments(..)+,Command(..)+,IdeCommand(..)+,isLSP+,commandP+,defaultMain+) where import           Control.Concurrent.Extra              (newLock, readVar,                                                         withLock) import           Control.Exception.Safe                (Exception (displayException),@@ -14,7 +22,8 @@                                                         isJust) import qualified Data.Text                             as T import qualified Data.Text.IO                          as T-import           Development.IDE                       (Action, Rules)+import           Development.IDE                       (Action, Rules,+                                                        hDuplicateTo') import           Development.IDE.Core.Debouncer        (Debouncer,                                                         newAsyncDebouncer) import           Development.IDE.Core.FileStore        (makeVFSHandle)@@ -53,7 +62,10 @@                                                         defaultIdeOptions) import           Development.IDE.Types.Shake           (Key (Key)) import           Development.Shake                     (action)+import           GHC.IO.Encoding                       (setLocaleEncoding)+import           GHC.IO.Handle                         (hDuplicate) import           HIE.Bios.Cradle                       (findCradle)+import qualified HieDb.Run                             as HieDb import           Ide.Plugin.Config                     (CheckParents (NeverCheck),                                                         Config,                                                         getConfigFromNotification)@@ -62,39 +74,75 @@                                                         pluginDescToIdePlugins) import           Ide.Types                             (IdePlugins) import qualified Language.LSP.Server                   as LSP+import           Options.Applicative                   hiding (action) import qualified System.Directory.Extra                as IO import           System.Exit                           (ExitCode (ExitFailure),                                                         exitWith) import           System.FilePath                       (takeExtension,                                                         takeFileName)-import           System.IO                             (BufferMode (LineBuffering),+import           System.IO                             (BufferMode (LineBuffering, NoBuffering),+                                                        Handle, hFlush,                                                         hPutStrLn,                                                         hSetBuffering,                                                         hSetEncoding, stderr,-                                                        stdout, utf8)+                                                        stdin, stdout, utf8) import           System.Time.Extra                     (offsetTime,                                                         showDuration) import           Text.Printf                           (printf) +data Command+    = Check [FilePath]  -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures+    | Db {projectRoot :: FilePath, hieOptions ::  HieDb.Options, hieCommand :: HieDb.Command}+     -- ^ Run a command in the hiedb+    | LSP   -- ^ Run the LSP server+    | Custom {projectRoot :: FilePath, ideCommand :: IdeCommand} -- ^ User defined+    deriving Show++newtype IdeCommand = IdeCommand (IdeState -> IO ())++instance Show IdeCommand where show _ = "<ide command>"++-- TODO move these to hiedb+deriving instance Show HieDb.Command+deriving instance Show HieDb.Options++isLSP :: Command -> Bool+isLSP LSP = True+isLSP _   = False++commandP :: Parser Command+commandP = hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo)+                    <> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo)+                    <> command "lsp" (info (pure LSP <**> helper) lspInfo)+                    )+  where+    fileCmd = many (argument str (metavar "FILES/DIRS..."))+    lspInfo = fullDesc <> progDesc "Start talking to an LSP client"+    fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work"+    hieInfo = fullDesc <> progDesc "Query .hie files"++ data Arguments = Arguments-    { argsOTMemoryProfiling :: Bool-    , argFiles :: Maybe [FilePath]   -- ^ Nothing: lsp server ;  Just: typecheck and exit-    , argsLogger :: IO Logger-    , argsRules :: Rules ()-    , argsHlsPlugins :: IdePlugins IdeState-    , argsGhcidePlugin :: Plugin Config  -- ^ Deprecated+    { argsOTMemoryProfiling     :: Bool+    , argCommand                :: Command+    , argsLogger                :: IO Logger+    , argsRules                 :: Rules ()+    , argsHlsPlugins            :: IdePlugins IdeState+    , argsGhcidePlugin          :: Plugin Config  -- ^ Deprecated     , argsSessionLoadingOptions :: SessionLoadingOptions-    , argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions-    , argsLspOptions :: LSP.Options-    , argsDefaultHlsConfig :: Config-    , argsGetHieDbLoc :: FilePath -> IO FilePath -- ^ Map project roots to the location of the hiedb for the project-    , argsDebouncer :: IO (Debouncer NormalizedUri) -- ^ Debouncer used for diagnostics+    , argsIdeOptions            :: Config -> Action IdeGhcSession -> IdeOptions+    , argsLspOptions            :: LSP.Options+    , argsDefaultHlsConfig      :: Config+    , argsGetHieDbLoc           :: FilePath -> IO FilePath -- ^ Map project roots to the location of the hiedb for the project+    , argsDebouncer             :: IO (Debouncer NormalizedUri) -- ^ Debouncer used for diagnostics+    , argsHandleIn              :: IO Handle+    , argsHandleOut             :: IO Handle     }  instance Default Arguments where     def = Arguments         { argsOTMemoryProfiling = False-        , argFiles = Nothing+        , argCommand = LSP         , argsLogger = stderrLogger         , argsRules = mainRule >> action kick         , argsGhcidePlugin = mempty@@ -105,6 +153,21 @@         , argsDefaultHlsConfig = def         , argsGetHieDbLoc = getHieDbLoc         , argsDebouncer = newAsyncDebouncer+        , argsHandleIn = pure stdin+        , argsHandleOut = do+                -- Move stdout to another file descriptor and duplicate stderr+                -- to stdout. This guards against stray prints from corrupting the JSON-RPC+                -- message stream.+                newStdout <- hDuplicate stdout+                stderr `hDuplicateTo'` stdout+                hSetBuffering stdout NoBuffering++                -- Print out a single space to assert that the above redirection works.+                -- This is interleaved with the logger, hence we just print a space here in+                -- order not to mess up the output too much. Verified that this breaks+                -- the language server tests without the redirection.+                putStr " " >> hFlush stdout+                return newStdout         }  -- | Cheap stderr logger that relies on LineBuffering@@ -116,25 +179,28 @@  defaultMain :: Arguments -> IO () defaultMain Arguments{..} = do+    setLocaleEncoding utf8     pid <- T.pack . show <$> getProcessID     logger <- argsLogger     hSetBuffering stderr LineBuffering -    let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins+    let hlsPlugin = asGhcIdePlugin argsHlsPlugins         hlsCommands = allLspCmdIds' pid argsHlsPlugins         plugins = hlsPlugin <> argsGhcidePlugin-        options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands }-        argsOnConfigChange _ide = pure . getConfigFromNotification argsDefaultHlsConfig+        options = argsLspOptions { LSP.executeCommandCommands = LSP.executeCommandCommands argsLspOptions <> Just hlsCommands }+        argsOnConfigChange = getConfigFromNotification         rules = argsRules >> pluginRules plugins      debouncer <- argsDebouncer+    inH <- argsHandleIn+    outH <- argsHandleOut -    case argFiles of-        Nothing -> do+    case argCommand of+        LSP -> do             t <- offsetTime             hPutStrLn stderr "Starting LSP server..."-            hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"-            runLanguageServer options argsGetHieDbLoc argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do+            hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!"+            runLanguageServer options inH outH argsGetHieDbLoc argsDefaultHlsConfig argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do                 t <- t                 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t @@ -164,7 +230,7 @@                     vfs                     hiedb                     hieChan-        Just argFiles -> do+        Check argFiles -> do           dir <- IO.getCurrentDirectory           dbLoc <- getHieDbLoc dir           runWithDb dbLoc $ \hiedb hieChan -> do@@ -190,7 +256,7 @@             putStrLn "\nStep 3/4: Initializing the IDE"             vfs <- makeVFSHandle             sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir-            let options = (argsIdeOptions Nothing sessionLoader)+            let options = (argsIdeOptions argsDefaultHlsConfig sessionLoader)                         { optCheckParents = pure NeverCheck                         , optCheckProject = pure False                         }@@ -225,7 +291,29 @@                 measureMemory logger [keys] consoleObserver valuesRef              unless (null failed) (exitWith $ ExitFailure (length failed))+        Db dir opts cmd -> do+            dbLoc <- getHieDbLoc dir+            hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc+            mlibdir <- setInitialDynFlags def+            case mlibdir of+                Nothing     -> exitWith $ ExitFailure 1+                Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd+        Custom projectRoot (IdeCommand c) -> do+          dbLoc <- getHieDbLoc projectRoot+          runWithDb dbLoc $ \hiedb hieChan -> do+            vfs <- makeVFSHandle+            sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions "."+            let options =+                  (argsIdeOptions argsDefaultHlsConfig sessionLoader)+                    { optCheckParents = pure NeverCheck,+                      optCheckProject = pure False+                    }+            ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan+            registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)+            c ide+ {-# ANN defaultMain ("HLint: ignore Use nubOrd" :: String) #-}+  expandFiles :: [FilePath] -> IO [FilePath] expandFiles = concatMapM $ \x -> do

@@ -35,6 +35,7 @@ import qualified Data.Rope.UTF16                                   as Rope import qualified Data.Set                                          as S import qualified Data.Text                                         as T+import           Data.Tuple.Extra                                  (fst3) import           Development.IDE.Core.RuleTypes import           Development.IDE.Core.Rules import           Development.IDE.Core.Service@@ -43,7 +44,8 @@ import           Development.IDE.GHC.Error import           Development.IDE.GHC.ExactPrint import           Development.IDE.GHC.Util                          (prettyPrint,-                                                                    printRdrName)+                                                                    printRdrName,+                                                                    unsafePrintSDoc) import           Development.IDE.Plugin.CodeAction.Args import           Development.IDE.Plugin.CodeAction.ExactPrint import           Development.IDE.Plugin.CodeAction.PositionIndexed@@ -71,7 +73,8 @@ import           RdrName                                           (GlobalRdrElt (..),                                                                     lookupGlobalRdrEnv) import           Safe                                              (atMay)-import           SrcLoc                                            (realSrcSpanStart)+import           SrcLoc                                            (realSrcSpanEnd,+                                                                    realSrcSpanStart) import           TcRnTypes                                         (ImportAvails (..),                                                                     TcGblEnv (..)) import           Text.Regex.TDFA                                   (mrAfter,@@ -114,7 +117,7 @@       actions =         [ mkCA title kind isPreferred [x] edit         | x <- xs, (title, kind, isPreferred, tedit) <- suggestAction $ CodeActionArgs exportsMap ideOptions parsedModule text df annotatedPS tcM har bindings gblSigs x-        , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing+        , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing         ]       actions' = caRemoveRedundantImports parsedModule text diag xs uri                <> actions@@ -123,7 +126,7 @@  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+  InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing Nothing  suggestAction :: CodeActionArgs -> GhcideCodeActions suggestAction caa =@@ -179,8 +182,8 @@ --  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-suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Rewrite])]-suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}+suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]+suggestHideShadow ps@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}   | Just [identifier, modName, s] <-       matchRegexUnifySpaces         _message@@ -205,8 +208,8 @@         mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName,         title <- "Hide " <> identifier <> " from " <> modName =         if modName == "Prelude" && null mDecl-          then [(title, maybeToList $ hideImplicitPreludeSymbol (T.unpack identifier) pm)]-          else maybeToList $ (title,) . pure . hideSymbol (T.unpack identifier) <$> mDecl+          then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps+          else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl       | otherwise = []  findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)@@ -279,6 +282,7 @@     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"@@ -289,6 +293,8 @@         _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@@ -325,6 +331,8 @@         _command = Nothing         _isPreferred = Nothing         _disabled = Nothing+        _xdata = Nothing+        _changeAnnotations = Nothing     removeAll [] = Nothing     removeAll ranges = Just $ InR $ CodeAction{..} where         tedit = concatMap (\r -> [TextEdit r ""]) ranges@@ -337,6 +345,8 @@         _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{..}@@ -738,7 +748,7 @@ indentation :: T.Text -> Int indentation = T.length . T.takeWhile isSpace -suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]+suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)] suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}     | Just [binding, mod, srcspan] <-       matchRegexUnifySpaces _message@@ -757,6 +767,7 @@             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@@ -808,7 +819,7 @@     Maybe T.Text ->     ParsedSource ->     Diagnostic ->-    [(T.Text, [Rewrite])]+    [(T.Text, [Either TextEdit Rewrite])] suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@Diagnostic {..}     | Just [ambiguous] <-         matchRegexUnifySpaces@@ -837,31 +848,39 @@         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-            | Just targets <- mapM toModuleTarget mods =-                sortOn fst-                [ ( renderUniquify mode modNameText symbol-                  , disambiguateSymbol ps diag symbol mode-                  )-                | (modTarget, restImports) <- oneAndOthers targets-                , let modName = targetModuleName modTarget-                      modNameText = T.pack $ moduleNameString modName-                , mode <--                    HideOthers restImports :-                    [ ToQualified parensed qual-                    | ExistingImp imps <- [modTarget]-                    , L _ qual <- nubOrd $ mapMaybe (ideclAs . unLoc)-                        $ NE.toList imps-                    ]-                    ++ [ToQualified parensed modName-                        | any (occursUnqualified symbol . unLoc)-                            (targetImports modTarget)-                        || case modTarget of-                            ImplicitPrelude{} -> True-                            _                 -> False-                        ]+          | hasDuplicate mods = case mapM toModuleTarget (removeAllDuplicates mods) of+                                  Just targets -> suggestionsImpl symbol (map (, []) targets)+                                  Nothing      -> []+          | otherwise         = case mapM toModuleTarget mods of+                                  Just targets -> suggestionsImpl symbol (oneAndOthers targets)+                                  Nothing      -> []+        suggestionsImpl symbol targetsWithRestImports = +            sortOn fst+            [ ( renderUniquify mode modNameText symbol+              , disambiguateSymbol ps diag symbol mode+              )+            | (modTarget, restImports) <- targetsWithRestImports+            , let modName = targetModuleName modTarget+                  modNameText = T.pack $ moduleNameString modName+            , mode <-+                [ ToQualified parensed qual+                | ExistingImp imps <- [modTarget]+                , L _ qual <- nubOrd $ mapMaybe (ideclAs . unLoc)+                    $ NE.toList imps                 ]-            | otherwise = []+                ++ [ToQualified parensed modName+                    | any (occursUnqualified symbol . unLoc)+                        (targetImports modTarget)+                    || case modTarget of+                        ImplicitPrelude{} -> True+                        _                 -> False+                    ]+                ++ [HideOthers restImports | not (null restImports)]+            ]         renderUniquify HideOthers {} modName symbol =             "Use " <> modName <> " for " <> symbol <> ", hiding other imports"         renderUniquify (ToQualified _ qual) _ symbol =@@ -897,23 +916,23 @@     Diagnostic ->     T.Text ->     HidingMode ->-    [Rewrite]+    [Either TextEdit Rewrite] disambiguateSymbol pm Diagnostic {..} (T.unpack -> symbol) = \case     (HideOthers hiddens0) ->-        [ hideSymbol symbol idecl+        [ Right $ hideSymbol symbol idecl         | ExistingImp idecls <- hiddens0         , idecl <- NE.toList idecls         ]             ++ mconcat                 [ if null imps-                    then maybeToList $ hideImplicitPreludeSymbol symbol pm-                    else hideSymbol symbol <$> imps+                    then maybeToList $ Left . snd <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) pm+                    else Right . hideSymbol symbol <$> imps                 | ImplicitPrelude imps <- hiddens0                 ]     (ToQualified parensed qualMod) ->         let occSym = mkVarOcc symbol             rdr = Qual qualMod occSym-         in [ if parensed+         in Right <$> [ if parensed                 then Rewrite (rangeToSrcSpan "<dummy>" _range) $ \df ->                     liftParseAST @(HsExpr GhcPs) df $                     prettyPrint $@@ -1136,7 +1155,7 @@  ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])]+suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message}   | Just [methodName, className] <-       matchRegexUnifySpaces@@ -1155,22 +1174,25 @@           -- extend           Just decl ->             [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText,-                [uncurry extendImport (unImportStyle style) decl]+                quickFixImportKind' "extend" style,+                [Right $ uncurry extendImport (unImportStyle style) decl]               )               | style <- importStyle             ]           -- new-          _ ->-            [ ( "Import " <> moduleNameText <> " with " <> rendered,-                maybeToList $ newUnqualImport (T.unpack moduleNameText) (T.unpack rendered) False ps-              )+          _+            | Just (range, indent) <- newImportInsertRange ps+            ->+             (\(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             ]-              <> maybeToList (("Import " <> moduleNameText,) <$> fmap pure (newImportAll (T.unpack moduleNameText) ps))+              <> [(quickFixImportKind "new.all", newImportAll moduleNameText)]+            | otherwise -> [] -suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)]-suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}+suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)]+suggestNewImport packageExportsMap ps@(L _ HsModule {..}) Diagnostic{_message}   | msg <- unifySpaces _message   , Just thingMissing <- extractNotInScopeName msg   , qual <- extractQualifiedModuleName msg@@ -1179,24 +1201,17 @@         >>= (findImportDeclByModuleName hsmodImports . T.unpack)         >>= ideclAs . unLoc         <&> T.pack . moduleNameString . unLoc-  , Just insertLine <- case hsmodImports of-        [] -> case srcSpanStart $ getLoc (head hsmodDecls) of-          RealSrcLoc s -> Just $ srcLocLine s - 1-          _            -> Nothing-        _ -> case srcSpanEnd $ getLoc (last hsmodImports) of-          RealSrcLoc s -> Just $ srcLocLine s-          _            -> Nothing-  , insertPos <- Position insertLine 0+  , Just (range, indent) <- newImportInsertRange ps   , extendImportSuggestions <- matchRegexUnifySpaces msg     "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"-  = [(imp, TextEdit (Range insertPos insertPos) (imp <> "\n"))-    | imp <- sort $ constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions+  = sortOn fst3 [(imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " "))+    | (kind, unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions     ] suggestNewImport _ _ _ = []  constructNewImportSuggestions-  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [T.Text]-constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrd+  :: 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)@@ -1205,18 +1220,74 @@   , suggestion <- renderNewImport identInfo   ]  where-  renderNewImport :: IdentInfo -> [T.Text]+  renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)]   renderNewImport identInfo     | Just q <- qual-    , asQ <- if q == m then "" else " as " <> q-    = ["import qualified " <> m <> asQ]+    = [(quickFixImportKind "new.qualified", newQualImport m q)]     | otherwise-    = ["import " <> m <> " (" <> renderImportStyle importStyle <> ")"+    = [(quickFixImportKind' "new" importStyle, newUnqualImport m (renderImportStyle importStyle) False)       | importStyle <- NE.toList $ importStyles identInfo] ++-      ["import " <> m ]+      [(quickFixImportKind "new.all", newImportAll m)]     where         m = moduleNameText identInfo +newtype NewImport = NewImport {unNewImport :: T.Text}+  deriving (Show, Eq, Ord)++newImportToEdit :: NewImport -> ParsedSource -> Maybe (T.Text, TextEdit)+newImportToEdit (unNewImport -> imp) ps+  | Just (range, indent) <- newImportInsertRange ps+  = Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " "))+  | otherwise = Nothing++newImportInsertRange :: ParsedSource -> Maybe (Range, Int)+newImportInsertRange (L _ HsModule {..})+  |  Just (uncurry Position -> insertPos, col) <- case hsmodImports of+      [] -> case getLoc (head hsmodDecls) of+        RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1+              in Just ((srcLocLine (realSrcSpanStart s) - 1, col), col)+        _            -> Nothing+      _ -> case  getLoc (last hsmodImports) of+        RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1+            in Just ((srcLocLine $ realSrcSpanEnd s,col), col)+        _            -> Nothing+    = Just (Range insertPos insertPos, col)+  | otherwise = Nothing++-- | 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 =+              " (" <> T.pack (unsafePrintSDoc (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 _                           = const True@@ -1494,10 +1565,20 @@   | otherwise   = ImportTopLevel rendered :| [] +-- | Used for adding new imports renderImportStyle :: ImportStyle -> T.Text-renderImportStyle (ImportTopLevel x)    = x+renderImportStyle (ImportTopLevel x)   = x+renderImportStyle (ImportViaParent x p@(T.uncons -> Just ('(', _))) = "type " <> p <> "(" <> x <> ")" renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")" +-- | 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)++quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind+quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.topLevel"+quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.withParent"++quickFixImportKind :: T.Text -> CodeActionKind+quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x

@@ -25,8 +25,12 @@ import           Retrie                                       (Annotated (astA)) import           Retrie.ExactPrint                            (annsA) +type CodeActionTitle = T.Text++type CodeActionPreferred = Bool+ -- | A compact representation of 'Language.LSP.Types.CodeAction's-type GhcideCodeActions = [(T.Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])]+type GhcideCodeActions = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])]  class ToTextEdit a where   toTextEdit :: CodeActionArgs -> a -> [TextEdit]@@ -105,16 +109,16 @@ instance ToCodeAction a => ToCodeAction (Maybe a) where   toCodeAction caa = maybe [] (toCodeAction caa) -instance ToTextEdit a => ToCodeAction (T.Text, a) where+instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where   toCodeAction caa (title, te) = [(title, Just CodeActionQuickFix, Nothing, toTextEdit caa te)] -instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, a) where+instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where   toCodeAction caa (title, kind, te) = [(title, Just kind, Nothing, toTextEdit caa te)] -instance ToTextEdit a => ToCodeAction (T.Text, Bool, a) where-  toCodeAction caa (title, isPreferred, te) = [(title, Nothing, Just isPreferred, toTextEdit caa te)]+instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where+  toCodeAction caa (title, isPreferred, te) = [(title, Just CodeActionQuickFix, Just isPreferred, toTextEdit caa te)] -instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, Bool, a) where+instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where   toCodeAction caa (title, kind, isPreferred, te) = [(title, Just kind, Just isPreferred, toTextEdit caa te)]  -------------------------------------------------------------------------------------------------

@@ -12,12 +12,8 @@   -- * Utilities   appendConstraint,   extendImport,-  hideImplicitPreludeSymbol,   hideSymbol,   liftParseAST,-  newImport,-  newUnqualImport,-  newImportAll, ) where  import           Control.Applicative@@ -39,20 +35,14 @@ import           Development.IDE.Spans.Common import           FieldLabel                            (flLabel) import           GHC.Exts                              (IsList (fromList))-import           GhcPlugins                            (mkRealSrcLoc,-                                                        realSrcSpanStart,-                                                        sigPrec)+import           GhcPlugins                            (mkRdrUnqual, sigPrec) import           Language.Haskell.GHC.ExactPrint import           Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),                                                         KeywordId (G), mkAnnKey) import           Language.LSP.Types import           OccName-import           Outputable                            (ppr, showSDoc,-                                                        showSDocUnsafe)-import           Retrie.GHC                            (mkRealSrcSpan,-                                                        rdrNameOcc,-                                                        realSrcSpanEnd,-                                                        unpackFS)+import           Outputable                            (ppr, showSDocUnsafe)+import           Retrie.GHC                            (rdrNameOcc, unpackFS)  ------------------------------------------------------------------------------ @@ -93,6 +83,7 @@     WorkspaceEdit       { _changes = Just (fromList [(uri, List edits)])       , _documentChanges = Nothing+      , _changeAnnotations = Nothing       }  ------------------------------------------------------------------------------@@ -209,44 +200,48 @@   Rewrite l $ \df -> do     case mparent of       Just parent -> extendImportViaParent df parent identifier lDecl-      _           -> extendImportTopLevel df identifier lDecl+      _           -> extendImportTopLevel identifier lDecl --- | Add an identifier to import list+-- | Add an identifier or a data type to import list -- -- extendImportTopLevel "foo" AST: -- -- import A --> Error -- import A (foo) --> Error -- import A (bar) --> import A (bar, foo)-extendImportTopLevel :: DynFlags -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)-extendImportTopLevel df idnetifier (L l it@ImportDecl{..})+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-    rdr <- liftParseAST df idnetifier+    let rdr = L src $ mkRdrUnqual $ mkVarOcc thing      let alreadyImported =           showNameWithoutUniques (occName (unLoc rdr))             `elem` map (showNameWithoutUniques @OccName) (listify (const True) lies)     when alreadyImported $-      lift (Left $ idnetifier <> " already imported")+      lift (Left $ thing <> " already imported")      let lie = L src $ IEName rdr         x = L top $ IEVar noExtField lie     if x `elem` lies-      then lift (Left $ idnetifier <> " already imported")+      then lift (Left $ thing <> " already imported")       else do         when hasSibling $           addTrailingCommaT (last lies)         addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) []-        addSimpleAnnT rdr dp00 $ unqalDP $ hasParen idnetifier+        addSimpleAnnT rdr dp00 [(G AnnVal, dp00)]         -- 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])}-extendImportTopLevel _ _ _ = lift $ Left "Unable to extend the import list"+extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"  -- | Add an identifier with its parent to import list --@@ -258,7 +253,14 @@ -- 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 :: DynFlags -> String -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)+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@@ -269,8 +271,8 @@     -- ThingAbs ie => ThingWith ie child     | parent == unIEWrappedName ie = do       srcChild <- uniqueSrcSpanT-      childRdr <- liftParseAST df child-      let childLIE = L srcChild $ IEName childRdr+      let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child+          childLIE = L srcChild $ IEName childRdr           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)]}@@ -282,7 +284,7 @@       , hasSibling <- not $ null lies' =       do         srcChild <- uniqueSrcSpanT-        childRdr <- liftParseAST df child+        let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child          let alreadyImported =               showNameWithoutUniques (occName (unLoc childRdr))@@ -293,7 +295,7 @@         when hasSibling $           addTrailingCommaT (last lies')         let childLIE = L srcChild $ IEName childRdr-        addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP $ hasParen child+        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)}   go hide l' pre (x : xs) = go hide l' (x : pre) xs   go hide l' pre []@@ -303,14 +305,18 @@       srcParent <- uniqueSrcSpanT       srcChild <- uniqueSrcSpanT       parentRdr <- liftParseAST df parent-      childRdr <- liftParseAST df child+      let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child+          isParentOperator = hasParen parent       when hasSibling $         addTrailingCommaT (head pre)-      let parentLIE = L srcParent $ IEName parentRdr+      let parentLIE = L srcParent $ (if isParentOperator then IEType else IEName) parentRdr           childLIE = L srcChild $ IEName childRdr           x :: LIE GhcPs = L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] []-      addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP $ hasParen parent-      addSimpleAnnT childRdr (DP (0, 0)) $ unqalDP $ hasParen child+      -- 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.@@ -326,10 +332,10 @@ hasParen ('(' : _) = True hasParen _         = False -unqalDP :: Bool -> [(KeywordId, DeltaPos)]-unqalDP paren =+unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)]+unqalDP c paren =   ( if paren-      then \x -> (G AnnOpenP, dp00) : x : [(G AnnCloseP, dp00)]+      then \x -> (G AnnOpenP, DP (0, c)) : x : [(G AnnCloseP, dp00)]       else pure   )     (G AnnVal, dp00)@@ -373,7 +379,7 @@       , (G AnnCloseP, DP (0, 0))       ]   addSimpleAnnT x (DP (0, 0)) []-  addSimpleAnnT rdr dp00 $ unqalDP $ isOperator $ unLoc rdr+  addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr   if hasSibling     then when hasSibling $ do       addTrailingCommaT x@@ -432,69 +438,3 @@             (filter ((/= symbol) . unqualIEWrapName . unLoc) cons)             (filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds)   killLie v = Just v---- | Insert a import declaration with at most one symbol---- newImport "A" (Just "Bar(Cons)") Nothing False --> import A (Bar(Cons))--- newImport "A" (Just "foo") Nothing True --> import A hiding (foo)--- newImport "A" Nothing (Just "Q") False --> import qualified A as Q------ Wrong combinations will result in parse error--- Returns Nothing if there is no imports and declarations-newImport ::-  -- | module name-  String ->-  -- | the symbol-  Maybe String ->-  -- | whether to be qualified-  Maybe String ->-  -- | the symbol is to be imported or hidden-  Bool ->-  ParsedSource ->-  Maybe Rewrite-newImport modName mSymbol mQual hiding (L _ HsModule{..}) = do-  -- TODO (berberman): if the previous line is module name and there is no other imports,-  -- 'AnnWhere' will be crowded out to the next line, which is a bug-  let predLine old =-        mkRealSrcLoc-          (srcLocFile old)-          (srcLocLine old - 1)-          (srcLocCol old)-      existingImpSpan = (fmap (realSrcSpanEnd,) . realSpan . getLoc) =<< lastMaybe hsmodImports-      existingDeclSpan = (fmap (predLine . realSrcSpanStart,) . realSpan . getLoc) =<< headMaybe hsmodDecls-  (f, s) <- existingImpSpan <|> existingDeclSpan-  let beg = f s-      indentation = srcSpanStartCol s-      ran = RealSrcSpan $ mkRealSrcSpan beg beg-  pure $-    Rewrite ran $ \df -> do-      let symImp-            | Just symbol <- mSymbol-              , symOcc <- mkVarOcc symbol =-              "(" <> showSDoc df (parenSymOcc symOcc $ ppr symOcc) <> ")"-            | otherwise = ""-          impStmt =-            "import "-              <> maybe "" (const "qualified ") mQual-              <> modName-              <> (if hiding then " hiding " else " ")-              <> symImp-              <> maybe "" (" as " <>) mQual-      -- Re-labeling is needed to reflect annotations correctly-      L _ idecl0 <- liftParseAST @(ImportDecl GhcPs) df impStmt-      let idecl = L ran idecl0-      addSimpleAnnT-        idecl-        (DP (1, indentation - 1))-        [(G AnnImport, DP (1, indentation - 1))]-      pure idecl--newUnqualImport :: String -> String -> Bool -> ParsedSource -> Maybe Rewrite-newUnqualImport modName symbol = newImport modName (Just symbol) Nothing--newImportAll :: String -> ParsedSource -> Maybe Rewrite-newImportAll modName = newImport modName Nothing Nothing False---- | Insert "import Prelude hiding (symbol)"-hideImplicitPreludeSymbol :: String -> ParsedSource -> Maybe Rewrite-hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True

@@ -35,7 +35,7 @@ import           Development.Shake.Classes import           GHC.Exts                                     (toList) import           GHC.Generics-import           Ide.Plugin.Config                            (Config (completionSnippetsOn))+import           Ide.Plugin.Config                            (Config) import           Ide.Types import qualified Language.LSP.Server                          as LSP import           Language.LSP.Types@@ -47,6 +47,7 @@   { pluginRules = produceCompletions   , pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP   , pluginCommands = [extendImportCommand]+  , pluginCustomConfig = mkCustomConfig properties   }  produceCompletions :: Rules ()@@ -135,9 +136,8 @@                 -> return (InL $ List [])               (Just pfix', _) -> do                 let clientCaps = clientCapabilities $ shakeExtras ide-                config <- getClientConfig $ shakeExtras ide-                let snippets = WithSnippets . completionSnippetsOn $ config-                allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps snippets+                config <- getCompletionsConfig plId+                allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config                 pure $ InL (List allCompletions)               _ -> return (InL $ List [])           _ -> return (InL $ List [])

@@ -9,7 +9,6 @@   CachedCompletions , cacheDataProducer , localCompletionsForParsedModule-, WithSnippets(..) , getCompletions ) where @@ -56,8 +55,7 @@ import           GhcPlugins                               (flLabel, unpackFS) import           Ide.PluginUtils                          (mkLspCommand) import           Ide.Types                                (CommandId (..),-                                                           PluginId,-                                                           WithSnippets (..))+                                                           PluginId) import           Language.LSP.Types import           Language.LSP.Types.Capabilities import qualified Language.LSP.VFS                         as VFS@@ -145,7 +143,7 @@   | isTcOcc   oc = case ty of                      Just t                        | "Constraint" `T.isSuffixOf` t-                       -> CiClass+                       -> CiInterface                      _ -> CiStruct   | isDataOcc oc = CiConstructor   | otherwise    = CiVariable@@ -188,6 +186,7 @@                   _filterText = Nothing,                   _insertText = Just insertText,                   _insertTextFormat = Just Snippet,+                  _insertTextMode = Nothing,                   _textEdit = Nothing,                   _additionalTextEdits = Nothing,                   _commitCharacters = Nothing,@@ -274,13 +273,13 @@ mkModCompl label =   CompletionItem label (Just CiModule) Nothing Nothing     Nothing Nothing Nothing Nothing Nothing Nothing Nothing-    Nothing Nothing Nothing Nothing Nothing+    Nothing Nothing Nothing Nothing Nothing Nothing  mkImportCompl :: T.Text -> T.Text -> CompletionItem mkImportCompl enteredQual label =   CompletionItem m (Just CiModule) Nothing (Just label)     Nothing Nothing Nothing Nothing Nothing Nothing Nothing-    Nothing Nothing Nothing Nothing Nothing+    Nothing Nothing Nothing Nothing Nothing Nothing   where     m = fromMaybe "" (T.stripPrefix enteredQual label) @@ -288,13 +287,13 @@ mkExtCompl label =   CompletionItem label (Just CiKeyword) Nothing Nothing     Nothing Nothing Nothing Nothing Nothing Nothing Nothing-    Nothing Nothing Nothing Nothing Nothing+    Nothing Nothing Nothing Nothing Nothing Nothing  mkPragmaCompl :: T.Text -> T.Text -> CompletionItem mkPragmaCompl label insertText =   CompletionItem label (Just CiKeyword) Nothing Nothing     Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)-    Nothing Nothing Nothing Nothing Nothing+    Nothing Nothing Nothing Nothing Nothing Nothing   cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions@@ -406,7 +405,7 @@                 [mkComp id CiVariable Nothing                 | VarPat _ id <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs]             TyClD _ ClassDecl{tcdLName, tcdSigs} ->-                mkComp tcdLName CiClass Nothing :+                mkComp tcdLName CiInterface Nothing :                 [ mkComp id CiFunction (Just $ ppr typ)                 | L _ (TypeSig _ ids typ) <- tcdSigs                 , id <- ids]@@ -428,7 +427,7 @@         ]      mkComp n ctyp ty =-        CI ctyp pn (Right thisModName) ty pn Nothing doc (ctyp `elem` [CiStruct, CiClass]) Nothing+        CI ctyp pn (Right thisModName) ty pn Nothing doc (ctyp `elem` [CiStruct, CiInterface]) Nothing       where         pn = ppr n         doc = SpanDocText (getDocumentation [pm] n) (SpanDocUris Nothing Nothing)@@ -465,13 +464,17 @@ ppr :: Outputable a => a -> T.Text ppr = T.pack . prettyPrint -toggleSnippets :: ClientCapabilities -> WithSnippets -> CompletionItem -> CompletionItem-toggleSnippets ClientCapabilities {_textDocument} (WithSnippets with) =+toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem+toggleSnippets ClientCapabilities {_textDocument} (CompletionsConfig with _) =   removeSnippetsWhen (not $ with && supported)   where     supported =       Just True == (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport) +toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem+toggleAutoExtend (CompletionsConfig _ False) x = x {additionalTextEdits = Nothing}+toggleAutoExtend _ x = x+ removeSnippetsWhen :: Bool -> CompletionItem -> CompletionItem removeSnippetsWhen condition x =   if condition@@ -491,10 +494,10 @@     -> (Bindings, PositionMapping)     -> VFS.PosPrefixInfo     -> ClientCapabilities-    -> WithSnippets+    -> CompletionsConfig     -> IO [CompletionItem] getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, importableModules}-               maybe_parsed (localBindings, bmapping) prefixInfo caps withSnippets = do+               maybe_parsed (localBindings, bmapping) prefixInfo caps config = do   let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo       enteredQual = if T.null prefixModule then "" else prefixModule <> "."       fullPrefix  = enteredQual <> prefixText@@ -530,7 +533,7 @@                         Just ValueContext -> filter (not . isTypeCompl) compls                         Just _            -> filter (not . isTypeCompl) compls           -- Add whether the text to insert has backticks-          ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'+          ctxCompls = map (\comp -> toggleAutoExtend config $ comp { isInfix = infixCompls }) ctxCompls'            infixCompls :: Maybe Backtick           infixCompls = isUsedAsInfix fullLine prefixModule prefixText pos@@ -562,7 +565,7 @@         ]        filtListWithSnippet f list suffix =-        [ toggleSnippets caps withSnippets (f label (snippet <> suffix))+        [ toggleSnippets caps config (f label (snippet <> suffix))         | (snippet, label) <- list         , Fuzzy.test fullPrefix label         ]@@ -596,7 +599,7 @@         compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls         return $ filtModNameCompls               ++ filtKeywordCompls-              ++ map ( toggleSnippets caps withSnippets) compls+              ++ map (toggleSnippets caps config) compls   -- ---------------------------------------------------------------------

@@ -1,5 +1,7 @@ {-# LANGUAGE DeriveAnyClass     #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GADTs              #-}+{-# LANGUAGE OverloadedLabels   #-} module Development.IDE.Plugin.Completions.Types (   module Development.IDE.Plugin.Completions.Types ) where@@ -13,6 +15,11 @@ import           Data.Text                    (Text) import           Development.IDE.Spans.Common import           GHC.Generics                 (Generic)+import           Ide.Plugin.Config            (Config)+import           Ide.Plugin.Properties+import           Ide.PluginUtils              (usePropertyLsp)+import           Ide.Types                    (PluginId)+import           Language.LSP.Server          (MonadLsp) import           Language.LSP.Types           (CompletionItemKind, Uri)  -- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs@@ -22,6 +29,29 @@  extendImportCommandId :: Text extendImportCommandId = "extendImport"++properties :: Properties+  '[ 'PropertyKey "autoExtendOn" 'TBoolean,+     'PropertyKey "snippetsOn" 'TBoolean]+properties = emptyProperties+  & defineBooleanProperty #snippetsOn+    "Inserts snippets when using code completions"+    True+  & defineBooleanProperty #autoExtendOn+    "Extends the import list automatically when completing a out-of-scope identifier"+    True++getCompletionsConfig :: (MonadLsp Config m) => PluginId -> m CompletionsConfig+getCompletionsConfig pId =+  CompletionsConfig+    <$> usePropertyLsp #snippetsOn pId properties+    <*> usePropertyLsp #autoExtendOn pId properties+++data CompletionsConfig = CompletionsConfig {+  enableSnippets   :: Bool,+  enableAutoExtend :: Bool+}  data ExtendImport = ExtendImport   { doc         :: !Uri,

@@ -1,5 +1,7 @@-{-# LANGUAGE GADTs     #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds         #-}  module Development.IDE.Plugin.HLS     (@@ -8,6 +10,7 @@  import           Control.Exception            (SomeException) import           Control.Monad+import           Control.Monad.IO.Class import qualified Data.Aeson                   as J import           Data.Bifunctor import           Data.Dependent.Map           (DMap)@@ -17,13 +20,13 @@ import qualified Data.List                    as List import           Data.List.NonEmpty           (NonEmpty, nonEmpty, toList) import qualified Data.Map                     as Map-import           Data.Maybe                   (fromMaybe) import           Data.String import qualified Data.Text                    as T import           Development.IDE.Core.Shake import           Development.IDE.Core.Tracing import           Development.IDE.LSP.Server import           Development.IDE.Plugin+import           Development.IDE.Types.Logger import           Development.Shake            (Rules) import           Ide.Plugin.Config import           Ide.PluginUtils              (getClientConfig)@@ -40,13 +43,13 @@ --  -- | Map a set of plugins to the underlying ghcide engine.-asGhcIdePlugin :: Config -> IdePlugins IdeState -> Plugin Config-asGhcIdePlugin defaultConfig mp =+asGhcIdePlugin :: IdePlugins IdeState -> Plugin Config+asGhcIdePlugin (IdePlugins ls) =     mkPlugin rulesPlugins HLS.pluginRules <>     mkPlugin executeCommandPlugins HLS.pluginCommands <>-    mkPlugin (extensiblePlugins defaultConfig)  HLS.pluginHandlers+    mkPlugin extensiblePlugins HLS.pluginHandlers <>+    mkPlugin extensibleNotificationPlugins HLS.pluginNotificationHandlers     where-        ls = Map.toList (ipMap mp)          mkPlugin :: ([(PluginId, b)] -> Plugin Config) -> (PluginDescriptor IdeState -> b) -> Plugin Config         mkPlugin maker selector =@@ -128,8 +131,8 @@  -- --------------------------------------------------------------------- -extensiblePlugins :: Config -> [(PluginId, PluginHandlers IdeState)] -> Plugin Config-extensiblePlugins defaultConfig xs = Plugin mempty handlers+extensiblePlugins :: [(PluginId, PluginHandlers IdeState)] -> Plugin Config+extensiblePlugins xs = Plugin mempty handlers   where     IdeHandlers handlers' = foldMap bakePluginId xs     bakePluginId :: (PluginId, PluginHandlers IdeState) -> IdeHandlers@@ -139,7 +142,7 @@     handlers = mconcat $ do       (IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers'       pure $ requestHandler m $ \ide params -> do-        config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig+        config <- Ide.PluginUtils.getClientConfig         let fs = filter (\(pid,_) -> pluginEnabled m pid config) fs'         case nonEmpty fs of           Nothing -> pure $ Left $ ResponseError InvalidRequest@@ -154,7 +157,32 @@               Just xs -> do                 caps <- LSP.getClientCapabilities                 pure $ Right $ combineResponses m config caps params xs+-- --------------------------------------------------------------------- +extensibleNotificationPlugins :: [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config+extensibleNotificationPlugins xs = Plugin mempty handlers+  where+    IdeNotificationHandlers handlers' = foldMap bakePluginId xs+    bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers+    bakePluginId (pid,PluginNotificationHandlers hs) = IdeNotificationHandlers $ DMap.map+      (\(PluginNotificationHandler f) -> IdeNotificationHandler [(pid,f pid)])+      hs+    handlers = mconcat $ do+      (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers'+      pure $ notificationHandler m $ \ide params -> do+        config <- Ide.PluginUtils.getClientConfig+        let fs = filter (\(pid,_) -> plcGlobalOn $ configForPlugin config pid) fs'+        case nonEmpty fs of+          Nothing -> do+              liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins no enabled plugins"+              pure ()+          Just fs -> do+            -- We run the notifications in order, so the core ghcide provider+            -- (which restarts the shake process) hopefully comes last+              mapM_ (\(pid,f) -> otTracedProvider pid (fromString $ show m) $ f ide params) fs++-- ---------------------------------------------------------------------+ runConcurrently   :: MonadUnliftIO m   => (SomeException -> PluginId -> T.Text)@@ -175,12 +203,25 @@ newtype IdeHandler (m :: J.Method FromClient Request)   = IdeHandler [(PluginId,IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))] +-- | Combine the 'PluginHandler' for all plugins+newtype IdeNotificationHandler (m :: J.Method FromClient Notification)+  = IdeNotificationHandler [(PluginId, IdeState -> MessageParams m -> LSP.LspM Config ())]+-- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()`+ -- | Combine the 'PluginHandlers' for all plugins-newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler)+newtype IdeHandlers             = IdeHandlers             (DMap IdeMethod       IdeHandler)+newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler)  instance Semigroup IdeHandlers where   (IdeHandlers a) <> (IdeHandlers b) = IdeHandlers $ DMap.unionWithKey go a b     where-      go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a ++ b)+      go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a <> b) instance Monoid IdeHandlers where   mempty = IdeHandlers mempty++instance Semigroup IdeNotificationHandlers where+  (IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b+    where+      go _ (IdeNotificationHandler a) (IdeNotificationHandler b) = IdeNotificationHandler (a <> b)+instance Monoid IdeNotificationHandlers where+  mempty = IdeNotificationHandlers mempty

@@ -1,29 +1,31 @@ {-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings     #-}  -- | Exposes the ghcide features as an HLS plugin module Development.IDE.Plugin.HLS.GhcIde   (     descriptors   ) where-import Development.IDE-import Development.IDE.LSP.HoverDefinition-import Development.IDE.LSP.Outline-import Ide.Types-import Language.LSP.Types-import Language.LSP.Server (LspM)-import Text.Regex.TDFA.Text()-import qualified Development.IDE.Plugin.CodeAction as CodeAction-import qualified Development.IDE.Plugin.Completions as Completions-import qualified Development.IDE.Plugin.TypeLenses as TypeLenses-import Control.Monad.IO.Class+import           Control.Monad.IO.Class+import           Development.IDE+import           Development.IDE.LSP.HoverDefinition+import qualified Development.IDE.LSP.Notifications   as Notifications+import           Development.IDE.LSP.Outline+import qualified Development.IDE.Plugin.CodeAction   as CodeAction+import qualified Development.IDE.Plugin.Completions  as Completions+import qualified Development.IDE.Plugin.TypeLenses   as TypeLenses+import           Ide.Types+import           Language.LSP.Server                 (LspM)+import           Language.LSP.Types+import           Text.Regex.TDFA.Text                ()  descriptors :: [PluginDescriptor IdeState] descriptors =   [ descriptor "ghcide-hover-and-symbols",     CodeAction.descriptor "ghcide-code-actions",     Completions.descriptor "ghcide-completions",-    TypeLenses.descriptor "ghcide-type-lenses"+    TypeLenses.descriptor "ghcide-type-lenses",+    Notifications.descriptor "ghcide-core"   ]  -- ---------------------------------------------------------------------

@@ -1,5 +1,6 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE TypeFamilies   #-}+{-# LANGUAGE DeriveAnyClass   #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeFamilies     #-}  -- | An HLS plugin to provide code lenses for type signatures module Development.IDE.Plugin.TypeLenses (@@ -13,16 +14,14 @@  import           Avail                               (availsToNameSet) import           Control.DeepSeq                     (rwhnf)-import           Control.Monad                       (join)+import           Control.Monad                       (mzero) import           Control.Monad.Extra                 (whenMaybe) import           Control.Monad.IO.Class              (MonadIO (liftIO))-import qualified Data.Aeson                          as A-import           Data.Aeson.Types                    (Value (..), toJSON) import qualified Data.Aeson.Types                    as A+import           Data.Aeson.Types                    (Value (..), toJSON) import qualified Data.HashMap.Strict                 as Map import           Data.List                           (find)-import           Data.Maybe                          (catMaybes, fromJust,-                                                      fromMaybe)+import           Data.Maybe                          (catMaybes, fromJust) import qualified Data.Text                           as T import           Development.IDE                     (GhcSession (..),                                                       HscEnvEq (hscEnv),@@ -52,16 +51,17 @@                                                       realSrcLocSpan,                                                       tidyOpenType) import           HscTypes                            (mkPrintUnqualified)-import           Ide.Plugin.Config                   (Config,-                                                      PluginConfig (plcConfig))-import           Ide.PluginUtils                     (getPluginConfig,-                                                      mkLspCommand)+import           Ide.Plugin.Config                   (Config)+import           Ide.Plugin.Properties+import           Ide.PluginUtils                     (mkLspCommand,+                                                      usePropertyLsp) import           Ide.Types                           (CommandFunction,                                                       CommandId (CommandId),                                                       PluginCommand (PluginCommand),                                                       PluginDescriptor (..),                                                       PluginId,                                                       defaultPluginDescriptor,+                                                      mkCustomConfig,                                                       mkPluginHandler) import qualified Language.LSP.Server                 as LSP import           Language.LSP.Types                  (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),@@ -90,15 +90,24 @@     { pluginHandlers = mkPluginHandler STextDocumentCodeLens codeLensProvider     , pluginCommands = [PluginCommand (CommandId typeLensCommandId) "adds a signature" commandHandler]     , pluginRules = rules+    , pluginCustomConfig = mkCustomConfig properties     } +properties :: Properties '[ 'PropertyKey "mode" ('TEnum Mode)]+properties = emptyProperties+  & defineEnumProperty #mode "Control how type lenses are shown"+    [ (Always, "Always displays type lenses of global bindings")+    , (Exported, "Only display type lenses of exported global bindings")+    , (Diagnostics, "Follows error messages produced by GHC about missing signatures")+    ] Always+ codeLensProvider ::   IdeState ->   PluginId ->   CodeLensParams ->   LSP.LspM Config (Either ResponseError (List CodeLens)) codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentifier uri} = do-  (fromMaybe Always . join -> mode) <- fmap (parseCustomConfig . plcConfig) <$> getPluginConfig pId+  mode <- usePropertyLsp #mode pId properties   fmap (Right . List) $ case uriToFilePath' uri of     Just (toNormalizedFilePath' -> filePath) -> liftIO $ do       tmr <- runAction "codeLens.TypeCheck" ideState (use TypeCheck filePath)@@ -108,7 +117,7 @@       diag <- getDiagnostics ideState       hDiag <- getHiddenDiagnostics ideState -      let toWorkSpaceEdit tedit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing+      let toWorkSpaceEdit tedit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing           generateLensForGlobal sig@GlobalBindingTypeSig{..} = do             range <- srcSpanToRange $ gbSrcSpan sig             tedit <- gblBindingTypeSigToEdit sig@@ -202,13 +211,17 @@     Diagnostics   deriving (Eq, Ord, Show, Read, Enum) +instance A.ToJSON Mode where+  toJSON Always = "always"+  toJSON Exported = "exported"+  toJSON Diagnostics = "diagnostics"+ instance A.FromJSON Mode where-  parseJSON = A.withText "Mode" $ \s ->-    case T.toLower s of-      "always"      -> pure Always-      "exported"    -> pure Exported-      "diagnostics" -> pure Diagnostics-      _             -> A.unexpected (A.String s)+  parseJSON = A.withText "Mode" $ \case+    "always"      -> pure Always+    "exported"    -> pure Exported+    "diagnostics" -> pure Diagnostics+    _             -> mzero  -------------------------------------------------------------------------------- @@ -245,9 +258,6 @@     hsc <- use GhcSession nfp     result <- liftIO $ gblBindingType (hscEnv <$> hsc) (tmrTypechecked <$> tmr)     pure ([], result)--parseCustomConfig :: A.Object -> Maybe Mode-parseCustomConfig = A.parseMaybe (A..: "mode")  gblBindingType :: Maybe HscEnv -> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeSigsResult) gblBindingType (Just hsc) (Just gblEnv) = do

@@ -344,7 +344,7 @@  defRowToSymbolInfo :: Res DefRow -> Maybe SymbolInformation defRowToSymbolInfo (DefRow{..}:.(modInfoSrcFile -> Just srcFile))-  = Just $ SymbolInformation (showGhc defNameOcc) kind Nothing loc Nothing+  = Just $ SymbolInformation (showGhc defNameOcc) kind Nothing Nothing loc Nothing   where     kind       | isVarOcc defNameOcc = SkVariable

@@ -121,8 +121,15 @@   = "`" ++ i ++ "`" haddockToMarkdown (H.DocIdentifierUnchecked i)   = "`" ++ i ++ "`"-haddockToMarkdown (H.DocModule i)+haddockToMarkdown (H.DocModule (H.ModLink i Nothing))   = "`" ++ escapeBackticks i ++ "`"+-- See https://github.com/haskell/haddock/pull/1315+-- Module references can be labeled in markdown style, e.g. [some label]("Some.Module")+-- However, we don't want to use the link markup here, since the module name would be covered+-- up by the label. Thus, we keep both the label and module name in the following style:+-- some label ( `Some.Module` )+haddockToMarkdown (H.DocModule (H.ModLink i (Just label)))+  = haddockToMarkdown label ++ " ( `" ++ escapeBackticks i ++ "` )" haddockToMarkdown (H.DocWarning w)   = haddockToMarkdown w haddockToMarkdown (H.DocEmphasis d)

@@ -56,21 +56,30 @@         -- deliberately skip the rendered field         rnf name `seq` rnf parent `seq` rnf isDatacon `seq` rnf moduleNameText +-- | Render an identifier as imported or exported style.+-- TODO: pattern synonym+renderIEWrapped :: Name -> Text+renderIEWrapped n+  | isTcOcc occ && isSymOcc occ = "type " <> pack (printName n)+  | otherwise = pack $ printName n+  where+    occ = occName n+ mkIdentInfos :: Text -> AvailInfo -> [IdentInfo] mkIdentInfos mod (Avail n) =-    [IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n) mod]+    [IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod] mkIdentInfos mod (AvailTC parent (n:nn) flds)     -- Following the GHC convention that parent == n if parent is exported     | n == parent-    = [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) (isDataConName n) mod+    = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod         | n <- nn ++ map flSelector flds       ] ++-      [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n) mod]+      [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod]     where         parentP = pack $ printName parent  mkIdentInfos mod (AvailTC _ nn flds)-    = [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n) mod+    = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod         | n <- nn ++ map flSelector flds       ] 

@@ -18,6 +18,8 @@ import           Control.Monad.Extra           (eitherM, join, mapMaybeM) import           Control.Monad.IO.Class import           Data.Either                   (fromRight)+import           Data.Set                      (Set)+import qualified Data.Set                      as Set import           Data.Unique import           Development.IDE.GHC.Compat import           Development.IDE.GHC.Error     (catchSrcErrors)@@ -48,7 +50,7 @@                -- ^ In memory components for this HscEnv                -- This is only used at the moment for the import dirs in                -- the DynFlags-    , envImportPaths        :: Maybe [String]+    , envImportPaths        :: Maybe (Set FilePath)         -- ^ If Just, import dirs originally configured in this env         --   If Nothing, the env import dirs are unaltered     , envPackageExports     :: IO ExportsMap@@ -69,9 +71,9 @@     importPathsCanon <-       mapM canonicalizePath $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0) -    newHscEnvEqWithImportPaths (Just importPathsCanon) hscEnv deps+    newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps -newHscEnvEqWithImportPaths :: Maybe [String] -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq+newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do      let dflags = hsc_dflags hscEnv@@ -121,7 +123,7 @@ hscEnvWithImportPaths :: HscEnvEq -> HscEnv hscEnvWithImportPaths HscEnvEq{..}     | Just imps <- envImportPaths-    = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = imps}}+    = hscEnv{hsc_dflags = (hsc_dflags hscEnv){importPaths = Set.toList imps}}     | otherwise     = hscEnv 

@@ -14,11 +14,11 @@ import           GHC.Generics  -- | A mapping of module name to known files-type KnownTargets = HashMap Target [NormalizedFilePath]+type KnownTargets = HashMap Target (HashSet NormalizedFilePath)  data Target = TargetModule ModuleName | TargetFile NormalizedFilePath   deriving ( Eq, Generic, Show )   deriving anyclass (Hashable, NFData)  toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath-toKnownFiles = HSet.fromList . concat . HMap.elems+toKnownFiles = HSet.unions . HMap.elems

@@ -16,6 +16,7 @@   , IdeResult   , IdeGhcSession(..)   , OptHaddockParse(..)+  , ProgressReportingStyle(..)   ,optShakeFiles) where  import qualified Data.Text                         as T@@ -78,6 +79,7 @@   , optShakeOptions       :: ShakeOptions   , optSkipProgress       :: forall a. Typeable a => a -> Bool       -- ^ Predicate to select which rule keys to exclude from progress reporting.+  , optProgressStyle      :: ProgressReportingStyle   }  optShakeFiles :: IdeOptions -> Maybe FilePath@@ -104,6 +106,12 @@ newtype IdeTesting           = IdeTesting        Bool newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling    Bool +data ProgressReportingStyle+    = Percentage -- ^ Report using the LSP @_percentage@ field+    | Explicit   -- ^ Report using explicit 123/456 text+    | NoProgress -- ^ Do not report any percentage++ clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress clientSupportsProgress caps = IdeReportProgress $ Just True ==     (LSP._workDoneProgress =<< LSP._window (caps :: LSP.ClientCapabilities))@@ -131,6 +139,7 @@     ,optHaddockParse = HaddockParse     ,optCustomDynFlags = id     ,optSkipProgress = defaultSkipProgress+    ,optProgressStyle = Explicit     }  defaultSkipProgress :: Typeable a => a -> Bool

@@ -0,0 +1,6 @@+{-# LANGUAGE TemplateHaskell #-}+module THA where+import Language.Haskell.TH++th_a :: DecsQ+th_a = [d| a = () |]

@@ -0,0 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}+module THB where+import THA++$th_a

@@ -0,0 +1,5 @@+module THC where+import THB++c ::()+c = a

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["-Wmissing-signatures", "-package template-haskell", "THA", "THB", "THC"]}}

@@ -0,0 +1,6 @@+module A (template) where++import Language.Haskell.TH++template :: DecsQ+template = (\consA -> [DataD [] (mkName "A") [] Nothing [NormalC consA []] []]) <$> newName "A"

@@ -0,0 +1,5 @@+module B(A(A)) where++import A++template

@@ -0,0 +1,4 @@+module C where+import B++a = A

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["-XTemplateHaskell","-Wmissing-signatures","A", "B", "C"]}}

@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples #-}+module THA where+import Language.Haskell.TH++f :: Int -> (# Int, Int #)+f x = (# x , x+1 #)++th_a :: DecsQ+th_a = case f 1 of (# a , b #) -> [d| a = () |]

@@ -0,0 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}+module THB where+import THA++$th_a

@@ -0,0 +1,5 @@+module THC where+import THB++c ::()+c = a

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["-Wmissing-signatures", "-package template-haskell", "THA", "THB", "THC"]}}

@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}+module A where++import B( TB(..) )++newtype TA = MkTA Int+    deriving Eq++f :: TB -> TA+f (MkTB x) = MkTA x

@@ -0,0 +1,3 @@+module A where+newtype TA = MkTA Int+instance Eq TA

@@ -0,0 +1,7 @@+module B(TA(..), TB(..)) where+import {-# SOURCE #-} A( TA(..) )++data TB = MkTB !Int++g :: TA -> TB+g (MkTA x) = MkTB x

@@ -0,0 +1,8 @@+module C where++import B+import A hiding (MkTA(..))++x = MkTA+y = MkTB+z = f

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["A.hs", "A.hs-boot", "B.hs", "C.hs"]}}

@@ -0,0 +1,14 @@+cabal-version:       2.2++name:                a+version:             0.1.0.0+author:              Fendor+maintainer:          power.walross@gmail.com+build-type:          Simple++executable a+  main-is:             Main.hs+  hs-source-dirs:      src+  ghc-options:         -Wall+  build-depends:       base+  default-language:    Haskell2010

@@ -0,0 +1,3 @@+module Main where++main = putStrLn "Hello, Haskell!"

@@ -0,0 +1,1 @@+packages: ./a

@@ -0,0 +1,3 @@+cradle:+  cabal:+    component: "exe:a"

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 }

@@ -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 = (++)

@@ -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 = (++)

@@ -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 = (++)

@@ -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 = (++)

@@ -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.++)

@@ -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 = (++)

@@ -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 = (++)

@@ -0,0 +1,5 @@+module HidePreludeIndented where++   import AVec+   import Prelude hiding ((++))+   op = (++)

@@ -0,0 +1,4 @@+module HidePreludeIndented where++   import AVec+   op = (++)

@@ -0,0 +1,10 @@+module HideQualifyDuplicateRecordFields where++import AVec+import BVec+import CVec+import DVec+import EVec+import FVec++theFun = AVec.fromList

@@ -0,0 +1,10 @@+module HideQualifyDuplicateRecordFields where++import AVec+import BVec+import CVec+import DVec+import EVec+import FVec++theFun = fromList

@@ -0,0 +1,5 @@+module HideQualifyDuplicateRecordFieldsSelf where++import FVec++x = fromList

@@ -0,0 +1,5 @@+module HideQualifyInfix where++import AVec++infixed xs ys = xs Prelude.++ ys

@@ -0,0 +1,5 @@+module HideQualifyInfix where++import AVec++infixed xs ys = xs ++ ys

@@ -0,0 +1,5 @@+module HideQualifySectionLeft where++import AVec++sectLeft xs = (Prelude.++ xs)

@@ -0,0 +1,5 @@+module HideQualifySectionLeft where++import AVec++sectLeft xs = (++ xs)

@@ -0,0 +1,5 @@+module HideQualifySectionRight where++import AVec++sectLeft xs = (xs Prelude.++)

@@ -0,0 +1,5 @@+module HideQualifySectionRight where++import AVec++sectLeft xs = (xs ++)

@@ -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

@@ -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

@@ -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

@@ -0,0 +1,10 @@+cradle:+    direct:+        arguments:+        - -Wall+        - HideFunction.hs+        - AVec.hs+        - BVec.hs+        - CVec.hs+        - DVec.hs+        - EVec.hs

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["Foo", "Bar", "GotoHover"]}}

@@ -0,0 +1,8 @@+-- "missing signature" is declared a fatal warning in the cabal file,+-- but is ignored in this module.++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module IgnoreFatal where++a = 'a'

@@ -0,0 +1,1 @@+packages: ignore-fatal.cabal

@@ -0,0 +1,4 @@+cradle:+  cabal:+    - path: "."+      component: "lib:ignore-fatal"

@@ -0,0 +1,10 @@+name: ignore-fatal+version: 1.0.0+build-type: Simple+cabal-version: >= 1.2++library+  build-depends: base+  exposed-modules: IgnoreFatal+  hs-source-dirs: .+  ghc-options: -Werror=missing-signatures

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}+module KnownNat where+import Data.Proxy+import GHC.TypeLits++f :: forall n. KnownNat n => Proxy n -> Integer+f _ = natVal (Proxy :: Proxy n) + natVal (Proxy :: Proxy (n+2))+foo :: Int -> Int -> Int+foo a _b = a + c

@@ -0,0 +1,1 @@+packages: .

@@ -0,0 +1,9 @@+cabal-version:  1.18+name: plugin+version: 1.0.0+build-type: Simple++library+  build-depends: base, ghc-typelits-knownnat+  exposed-modules: KnownNat+  hs-source-dirs: .

@@ -0,0 +1,6 @@+{-# LANGUAGE DuplicateRecordFields, TypeApplications, TypeFamilies, UndecidableInstances, FlexibleContexts, DataKinds, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}+module RecordDot (Company(..), display) where+data Company = Company {name :: String}+display :: Company -> String+display c = c.name

@@ -0,0 +1,1 @@+packages: .

@@ -0,0 +1,9 @@+cabal-version:  1.18+name: plugin+version: 1.0.0+build-type: Simple++library+  build-depends: base, record-dot-preprocessor, record-hasfield+  exposed-modules: RecordDot+  hs-source-dirs: .

@@ -0,0 +1,6 @@+module A(x) where++import B++x :: Int+x = y

@@ -0,0 +1,4 @@+module B(y) where++y :: Int+y = undefined

@@ -0,0 +1,5 @@+module P() where+import A+import B++bar = x :: Int

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["-Wmissing-signatures","B", "A", "P"]}}

@@ -0,0 +1,14 @@+module Main where++import References++main :: IO ()+main = return ()++++a = 2 :: Int+b = a + 1++acc :: Account+acc = Savings

@@ -0,0 +1,9 @@+module OtherModule (symbolDefinedInOtherModule, symbolDefinedInOtherOtherModule) where++import OtherOtherModule++symbolDefinedInOtherModule = 1++symbolLocalToOtherModule = 2++someFxn x = x + symbolLocalToOtherModule

@@ -0,0 +1,3 @@+module OtherOtherModule where++symbolDefinedInOtherOtherModule = "asdf"

@@ -0,0 +1,25 @@+module References where++import OtherModule++foo = bar++bar = let x = bar 42 in const "hello"++baz = do+  x <- bar 23+  return $ bar 14++data Account =+  Checking+  | Savings++bobsAccount = Checking++bobHasChecking = case bobsAccount of+                     Checking -> True+                     Savings -> False++x = symbolDefinedInOtherModule++y = symbolDefinedInOtherOtherModule

@@ -0,0 +1,1 @@+cradle: {direct: {arguments: ["Main","OtherModule","OtherOtherModule","References"]}}

@@ -0,0 +1,3 @@+module Foo () where++foo = ()

@@ -0,0 +1,9 @@+name: foo+version: 1.0.0+build-type: Simple+cabal-version: >= 1.2++library+  build-depends: base+  exposed-modules: Foo+  hs-source-dirs: .

@@ -0,0 +1,3 @@+module Foo () where++foo = ()

@@ -0,0 +1,9 @@+name: foo+version: 1.0.0+build-type: Simple+cabal-version: >= 1.2++library+  build-depends: base+  exposed-modules: Foo+  hs-source-dirs: .

@@ -36,6 +36,7 @@                                                            positionResultToMaybe,                                                            toCurrent) import           Development.IDE.Core.Shake               (Q (..))+import qualified Development.IDE.Main                     as IDE import           Development.IDE.GHC.Util import           Development.IDE.Plugin.Completions.Types (extendImportCommandId) import           Development.IDE.Plugin.TypeLenses        (typeLensCommandId)@@ -75,7 +76,7 @@ import           System.Info.Extra                        (isWindows) import           System.Process.Extra                     (CreateProcess (cwd),                                                            proc,-                                                           readCreateProcessWithExitCode)+                                                           readCreateProcessWithExitCode, createPipe) import           Test.QuickCheck -- import Test.QuickCheck.Instances () import           Control.Lens                             ((^.))@@ -92,6 +93,15 @@ import           Test.Tasty.HUnit import           Test.Tasty.Ingredients.Rerun import           Test.Tasty.QuickCheck+import           Data.IORef+import           Ide.PluginUtils (pluginDescToIdePlugins)+import           Control.Concurrent.Async+import           Ide.Types+import           Data.String                              (IsString(fromString))+import qualified Language.LSP.Types                       as LSP+import           Data.IORef.Extra                         (atomicModifyIORef_)+import qualified Development.IDE.Plugin.HLS.GhcIde        as Ghcide+import           Text.Regex.TDFA                          ((=~))  waitForProgressBegin :: Session () waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case@@ -179,7 +189,7 @@     , chk "NO doc link"               _documentLinkProvider Nothing     , chk "NO color"                         _colorProvider (Just $ InL False)     , chk "NO folding range"          _foldingRangeProvider (Just $ InL False)-    , che "   execute command"      _executeCommandProvider [blockCommandId, extendImportCommandId, typeLensCommandId]+    , che "   execute command"      _executeCommandProvider [extendImportCommandId, typeLensCommandId, blockCommandId]     , chk "   workspace"                         _workspace (Just $ WorkspaceServerCapabilities (Just WorkspaceFoldersServerCapabilities{_supported = Just True, _changeNotifications = Just ( InR True )}))     , chk "NO experimental"                   _experimental Nothing     ] where@@ -846,7 +856,7 @@             ]       doc <- createDoc "Testing.hs" "haskell" content       _ <- waitForDiagnostics-      actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10))+      actionsOrCommands <- getAllCodeActions doc       let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands                                    , "Use type signature" `T.isInfixOf` actionTitle                            ]@@ -866,7 +876,7 @@             ]       doc <- createDoc "Testing.hs" "haskell" content       _ <- waitForDiagnostics-      actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10))+      actionsOrCommands <- getAllCodeActions doc       let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands                                     , "Use type signature" `T.isInfixOf` actionTitle                               ]@@ -889,7 +899,7 @@             ]       doc <- createDoc "Testing.hs" "haskell" content       _ <- waitForDiagnostics-      actionsOrCommands <- getCodeActions doc (Range (Position 4 1) (Position 4 10))+      actionsOrCommands <- getAllCodeActions doc       let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands                                     , "Use type signature" `T.isInfixOf` actionTitle                               ]@@ -906,6 +916,7 @@       liftIO $ expectedContentAfterAction @=? contentAfterAction   ] +{-# HLINT ignore "Use nubOrd" #-} removeImportTests :: TestTree removeImportTests = testGroup "remove import actions"   [ testSession "redundant" $ do@@ -1111,7 +1122,7 @@       doc <- createDoc "ModuleC.hs" "haskell" content       _ <- waitForDiagnostics       [_, _, _, _, InR action@CodeAction { _title = actionTitle }]-          <- getCodeActions doc (Range (Position 2 0) (Position 2 5))+          <- nub <$> getAllCodeActions doc       liftIO $ "Remove all redundant imports" @=? actionTitle       executeCodeAction action       contentAfterAction <- documentContents doc@@ -1149,7 +1160,7 @@                     , "import ModuleA as A (stuffB)"                     , "main = print (stuffA, stuffB)"                     ])-            (Range (Position 3 17) (Position 3 18))+            (Range (Position 2 17) (Position 2 18))             ["Add stuffA to the import list of ModuleA"]             (T.unlines                     [ "module ModuleB where"@@ -1169,7 +1180,7 @@                     , "import ModuleA as A (stuffB)"                     , "main = print (stuffB .* stuffB)"                     ])-            (Range (Position 3 17) (Position 3 18))+            (Range (Position 2 17) (Position 2 18))             ["Add (.*) to the import list of ModuleA"]             (T.unlines                     [ "module ModuleB where"@@ -1206,7 +1217,7 @@                     , "b :: A"                     , "b = Constructor"                     ])-            (Range (Position 2 5) (Position 2 5))+            (Range (Position 3 5) (Position 3 5))             ["Add A(Constructor) to the import list of ModuleA"]             (T.unlines                     [ "module ModuleB where"@@ -1225,7 +1236,7 @@                     , "b :: A"                     , "b = Constructor"                     ])-            (Range (Position 2 5) (Position 2 5))+            (Range (Position 3 5) (Position 3 5))             ["Add A(Constructor) to the import list of ModuleA"]             (T.unlines                     [ "module ModuleB where"@@ -1245,7 +1256,7 @@                     , "b :: A"                     , "b = ConstructorFoo"                     ])-            (Range (Position 2 5) (Position 2 5))+            (Range (Position 3 5) (Position 3 5))             ["Add A(ConstructorFoo) to the import list of ModuleA"]             (T.unlines                     [ "module ModuleB where"@@ -1266,7 +1277,7 @@                     , "import qualified ModuleA as A (stuffB)"                     , "main = print (A.stuffA, A.stuffB)"                     ])-            (Range (Position 3 17) (Position 3 18))+            (Range (Position 2 17) (Position 2 18))             ["Add stuffA to the import list of ModuleA"]             (T.unlines                     [ "module ModuleB where"@@ -1370,13 +1381,33 @@                     , "x = Refl"                     ])             (Range (Position 3 17) (Position 3 18))-            ["Add (:~:)(Refl) 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 ((:~:) (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"+                    ])         ]       where         codeActionTitle CodeAction{_title=x} = x@@ -1434,38 +1465,17 @@     [ testGroup         "new"         [ testSession "via parent" $-            template-              [ "module A where",-                ""-              ]-              (Range (Position 5 2) (Position 5 8))-              "Import Data.Semigroup with Semigroup(stimes)"-              [ "module A where",-                "",-                "import Data.Semigroup (Semigroup(stimes))"-              ],+            template'+            "import Data.Semigroup (Semigroup(stimes))"+            (Range (Position 5 2) (Position 5 8)),           testSession "top level" $-            template-              [ "module A where",-                ""-              ]-              (Range (Position 5 2) (Position 5 8))-              "Import Data.Semigroup with stimes"-              [ "module A where",-                "",-                "import Data.Semigroup (stimes)"-              ],+            template'+              "import Data.Semigroup (stimes)"+              (Range (Position 5 2) (Position 5 8)),           testSession "all" $-            template-              [ "module A where",-                ""-              ]+            template'+              "import Data.Semigroup"               (Range (Position 5 2) (Position 5 8))-              "Import Data.Semigroup"-              [ "module A where",-                "",-                "import Data.Semigroup"-              ]         ],       testGroup         "extend"@@ -1513,6 +1523,7 @@       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"@@ -1559,6 +1570,7 @@     , 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"@@ -1573,6 +1585,7 @@       , "qualified Data.Data as T"       ]                     "f = T.putStrLn"              []                "import qualified Data.Text.IO as T"     ]+    , expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)"   ]   where     test = test' False@@ -1580,8 +1593,9 @@     test' waitForCheckProject wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do       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]}}"+          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       _diags <- waitForDiagnostics@@ -1660,6 +1674,23 @@             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" $@@ -1695,16 +1726,14 @@             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"]+    auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"]     withTarget file locs k = withTempDir $ \dir -> runInDir dir $ do         liftIO $ mapM_ (\fp -> copyFile (hidingDir </> fp) $ dir </> fp)             $ file : auxFiles         doc <- openDoc file "haskell"         waitForProgressDone         void $ expectDiagnostics [(file, [(DsError, loc, "Ambiguous occurrence") | loc <- locs])]-        contents <- documentContents doc-        let range = Range (Position 0 0) (Position (length $ T.lines contents) 0)-        actions <- getCodeActions doc range+        actions <- getAllCodeActions doc         k doc actions     withHideFunction = withTarget ("HideFunction" <.> "hs") @@ -1911,7 +1940,7 @@       _ <- waitForDiagnostics       InR action@CodeAction { _title = actionTitle } : _                   <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>-                     getCodeActions docB (R 1 0 1 50)+                     getCodeActions docB (R 0 0 0 50)       liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool"       executeCodeAction action       contentAfterAction <- documentContents docB@@ -1935,7 +1964,7 @@       _ <- waitForDiagnostics       InR action@CodeAction { _title = actionTitle } : _                   <- sortOn (\(InR CodeAction{_title=x}) -> x) <$>-                     getCodeActions docB (R 1 0 1 50)+                     getCodeActions docB (R 0 0 0 50)       liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool"       executeCodeAction action       contentAfterAction <- documentContents docB@@ -2083,15 +2112,15 @@       docId <- createDoc "A.hs" "haskell" source       expectDiagnostics [ ("A.hs", [(DsWarning, pos, "not used")]) ] -      (action, title) <- extractCodeAction docId "Delete"+      (action, title) <- extractCodeAction docId "Delete" pos        liftIO $ title @?= expectedTitle       executeCodeAction action       contentAfterAction <- documentContents docId       liftIO $ contentAfterAction @?= expectedResult -    extractCodeAction docId actionPrefix = do-      [action@CodeAction { _title = actionTitle }]  <- findCodeActionsByPrefix docId (R 0 0 0 0) [actionPrefix]+    extractCodeAction docId actionPrefix (l, c) = do+      [action@CodeAction { _title = actionTitle }]  <- findCodeActionsByPrefix docId (R l c l c) [actionPrefix]       return (action, actionTitle)  addTypeAnnotationsToLiteralsTest :: TestTree@@ -2216,15 +2245,16 @@       docId <- createDoc "A.hs" "haskell" source       expectDiagnostics [ ("A.hs", diag) ] -      (action, title) <- extractCodeAction docId "Add type annotation"+      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 = do-      [action@CodeAction { _title = actionTitle }]  <- findCodeActionsByPrefix docId (R 0 0 0 0) [actionPrefix]+    extractCodeAction docId actionPrefix (l,c) (l', c')= do+      [action@CodeAction { _title = actionTitle }]  <- findCodeActionsByPrefix docId (R l c l' c') [actionPrefix]       return (action, actionTitle)  @@ -2270,7 +2300,7 @@             ]       doc <- createDoc "Testing.hs" "haskell" content       _ <- waitForDiagnostics-      actionsOrCommands <- getCodeActions doc (Range (Position 2 8) (Position 2 16))+      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@@ -2400,7 +2430,7 @@   check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do     doc <- createDoc "Testing.hs" "haskell" originalCode     _ <- waitForDiagnostics-    actionsOrCommands <- getCodeActions doc (Range (Position 6 0) (Position 6 68))+    actionsOrCommands <- getAllCodeActions doc     chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands     executeCodeAction chosenAction     modifiedCode <- documentContents doc@@ -2552,7 +2582,7 @@ checkCodeAction testName actionTitle originalCode expectedCode = testSession testName $ do   doc <- createDoc "Testing.hs" "haskell" originalCode   _ <- waitForDiagnostics-  actionsOrCommands <- getCodeActions doc (Range (Position 6 0) (Position 6 maxBound))+  actionsOrCommands <- getAllCodeActions doc   chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands   executeCodeAction chosenAction   modifiedCode <- documentContents doc@@ -2635,7 +2665,7 @@   check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do     doc <- createDoc "Testing.hs" "haskell" originalCode     _ <- waitForDiagnostics-    actionsOrCommands <- getCodeActions doc (Range (Position 4 0) (Position 4 maxBound))+    actionsOrCommands <- getAllCodeActions doc     chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands     executeCodeAction chosenAction     modifiedCode <- documentContents doc@@ -2645,7 +2675,7 @@   checkPeculiarFormatting title code = testSession title $ do     doc <- createDoc "Testing.hs" "haskell" code     _ <- waitForDiagnostics-    actionsOrCommands <- getCodeActions doc (Range (Position 4 0) (Position 4 maxBound))+    actionsOrCommands <- getAllCodeActions doc     liftIO $ assertBool "Found some actions" (null actionsOrCommands)    in testGroup "remove redundant function constraints"@@ -2789,7 +2819,7 @@               , "  ) where"               , "foo = id"               , "bar = foo"])-        (R 4 0 4 3)+        (R 5 0 5 3)         "Export ‘bar’"         (Just $ T.unlines               [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"@@ -3788,7 +3818,7 @@         "class"         ["bar :: Xx", "xxx = ()", "-- | haddock", "class Xxx a"]         (Position 0 9)-        [("Xxx", CiClass, "Xxx", False, True, Nothing)],+        [("Xxx", CiInterface, "Xxx", False, True, Nothing)],     completionTest         "records"         ["data Person = Person { _personName:: String, _personAge:: Int}", "bar = Person { _pers }" ]@@ -3882,7 +3912,7 @@       "type"       ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: Bo", "f = True"]       (Position 2 7)-      [ ("Bounded", CiClass, "Bounded ${1:*}", True, True, Nothing),+      [ ("Bounded", CiInterface, "Bounded ${1:*}", True, True, Nothing),         ("Bool", CiStruct, "Bool ", True, True, Nothing)       ],     completionTest@@ -3998,7 +4028,7 @@             ["module A where", "import Data.Type.Equality ()", "f = Ref"]             (Position 2 8)             "Refl"-            ["module A where", "import Data.Type.Equality ((:~:) (Refl))", "f = Ref"]+            ["module A where", "import Data.Type.Equality (type (:~:) (Refl))", "f = Ref"]         ]       , testGroup "Record completion"         [ completionCommandTest@@ -4183,7 +4213,7 @@     let source = T.unlines ["{-# language TypeFamilies #-}", "type family A"]     docId   <- createDoc "A.hs" "haskell" source     symbols <- getDocumentSymbols docId-    liftIO $ symbols @?= Left [docSymbolD "A" "type family" SkClass (R 1 0 1 13)]+    liftIO $ symbols @?= Left [docSymbolD "A" "type family" SkFunction (R 1 0 1 13)]   , testSessionWait "type family instance " $ do     let source = T.unlines           [ "{-# language TypeFamilies #-}"@@ -4193,14 +4223,14 @@     docId   <- createDoc "A.hs" "haskell" source     symbols <- getDocumentSymbols docId     liftIO $ symbols @?= Left-      [ docSymbolD "A a"   "type family" SkClass     (R 1 0 1 15)+      [ docSymbolD "A a"   "type family" SkFunction     (R 1 0 1 15)       , docSymbol "A ()" SkInterface (R 2 0 2 23)       ]   , testSessionWait "data family" $ do     let source = T.unlines ["{-# language TypeFamilies #-}", "data family A"]     docId   <- createDoc "A.hs" "haskell" source     symbols <- getDocumentSymbols docId-    liftIO $ symbols @?= Left [docSymbolD "A" "data family" SkClass (R 1 0 1 11)]+    liftIO $ symbols @?= Left [docSymbolD "A" "data family" SkFunction (R 1 0 1 11)]   , testSessionWait "data family instance " $ do     let source = T.unlines           [ "{-# language TypeFamilies #-}"@@ -4210,7 +4240,7 @@     docId   <- createDoc "A.hs" "haskell" source     symbols <- getDocumentSymbols docId     liftIO $ symbols @?= Left-      [ docSymbolD "A a"   "data family" SkClass     (R 1 0 1 11)+      [ docSymbolD "A a"   "data family" SkFunction     (R 1 0 1 11)       , docSymbol "A ()" SkInterface (R 2 0 2 25)       ]   , testSessionWait "constant" $ do@@ -4306,26 +4336,28 @@   ]  where   docSymbol name kind loc =-    DocumentSymbol name Nothing kind Nothing loc loc Nothing+    DocumentSymbol name Nothing kind Nothing Nothing loc loc Nothing   docSymbol' name kind loc selectionLoc =-    DocumentSymbol name Nothing kind Nothing loc selectionLoc Nothing+    DocumentSymbol name Nothing kind Nothing Nothing loc selectionLoc Nothing   docSymbolD name detail kind loc =-    DocumentSymbol name (Just detail) kind Nothing loc loc Nothing+    DocumentSymbol name (Just detail) kind Nothing Nothing loc loc Nothing   docSymbolWithChildren name kind loc cc =-    DocumentSymbol name Nothing kind Nothing loc loc (Just $ List cc)+    DocumentSymbol name Nothing kind Nothing Nothing loc loc (Just $ List cc)   docSymbolWithChildren' name kind loc selectionLoc cc =-    DocumentSymbol name Nothing kind Nothing loc selectionLoc (Just $ List cc)+    DocumentSymbol name Nothing kind Nothing Nothing loc selectionLoc (Just $ List cc)   moduleSymbol name loc cc = DocumentSymbol name                                             Nothing                                             SkFile                                             Nothing+                                            Nothing                                             (R 0 0 maxBound 0)                                             loc                                             (Just $ List cc)   classSymbol name loc cc = DocumentSymbol name                                            (Just "class")-                                           SkClass+                                           SkInterface                                            Nothing+                                           Nothing                                            loc                                            loc                                            (Just $ List cc)@@ -4881,7 +4913,7 @@               , "foo = id"               ]             void waitForDiagnostics-            actions <- getCodeActions doc (Range (Position 0 0) (Position 0 0))+            actions <- getCodeActions doc (Range (Position 1 0) (Position 1 0))             liftIO $ [ _title | InR CodeAction{_title} <- actions] @=?               [ "add signature: foo :: a -> a" ]     ]@@ -5163,21 +5195,26 @@   -- HIE calls getXgdDirectory which assumes that HOME is set.   -- Only sets HOME if it wasn't already set.   setEnv "HOME" "/homeless-shelter" False-  let lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True }+  conf <- getConfigFromEnv+  runSessionWithConfig conf cmd lspTestCaps projDir s++getConfigFromEnv :: IO SessionConfig+getConfigFromEnv = do   logColor <- fromMaybe True <$> checkEnv "LSP_TEST_LOG_COLOR"   timeoutOverride <- fmap read <$> getEnv "LSP_TIMEOUT"-  let conf = defaultConfig{messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride}-            -- uncomment this or set LSP_TEST_LOG_STDERR=1 to see all logging-            --   { logStdErr = True }-            --   uncomment this or set LSP_TEST_LOG_MESSAGES=1 to see all messages-            --   { logMessages = True }-  runSessionWithConfig conf{logColor} cmd lspTestCaps projDir s+  return defaultConfig+    { messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride+    , logColor+    }   where     checkEnv :: String -> IO (Maybe Bool)     checkEnv s = fmap convertVal <$> getEnv s     convertVal "0" = False     convertVal _   = True +lspTestCaps :: ClientCapabilities+lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True }+ openTestDataDoc :: FilePath -> Session TextDocumentIdentifier openTestDataDoc path = do   source <- liftIO $ readFileUtf8 $ "test/data" </> path@@ -5245,7 +5282,38 @@          let expected = "1:2-3:4"          assertBool (unwords ["expected to find range", expected, "in diagnostic", shown]) $              expected `isInfixOf` shown+     , testCase "notification handlers run sequentially" $ do+        orderRef <- newIORef []+        let plugins = pluginDescToIdePlugins $+                [ (defaultPluginDescriptor $ fromString $ show i)+                    { pluginNotificationHandlers = mconcat+                        [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ \_ _ _ ->+                            liftIO $ atomicModifyIORef_ orderRef (i:)+                        ]+                    }+                    | i <- [(1::Int)..20]+                ] ++ Ghcide.descriptors++        testIde def{IDE.argsHlsPlugins = plugins} $ do+            _ <- createDoc "haskell" "A.hs" "module A where"+            waitForProgressDone+            actualOrder <- liftIO $ readIORef orderRef++            liftIO $ actualOrder @?= reverse [(1::Int)..20]      ]++testIde :: IDE.Arguments -> Session () -> IO ()+testIde arguments session = do+    config <- getConfigFromEnv+    (hInRead, hInWrite) <- createPipe+    (hOutRead, hOutWrite) <- createPipe+    let server = IDE.defaultMain arguments+            { IDE.argsHandleIn = pure hInRead+            , IDE.argsHandleOut = pure hOutWrite+            }++    withAsync server $ \_ ->+        runSessionWithHandles hInWrite hOutRead config lspTestCaps "." session  positionMappingTests :: TestTree positionMappingTests =