From 4853ccb6365163954eb0ab250182ecb9be45ed79 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 12 Dec 2021 20:11:49 +0000 Subject: [PATCH 001/149] WIP --- cabal-ghc921.project | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 21c1833847..000ac09ded 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -14,18 +14,34 @@ packages: ./plugins/hls-eval-plugin ./plugins/hls-explicit-imports-plugin ./plugins/hls-refine-imports-plugin - ./plugins/hls-hlint-plugin - -- ./plugins/hls-retrie-plugin + -- ./plugins/hls-hlint-plugin + ./plugins/hls-retrie-plugin ./plugins/hls-haddock-comments-plugin -- ./plugins/hls-splice-plugin ./plugins/hls-qualify-imported-names-plugin - ./plugins/hls-floskell-plugin + -- ./plugins/hls-floskell-plugin ./plugins/hls-pragmas-plugin ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin + -- ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin ./plugins/hls-alternate-number-format-plugin +source-repository-package + type: git + location: https://github.com/Bodigrim/th-extras + tag: f00ebca78f474d271fd7989cae0a0a47559b2efd + -- https://github.com/mokus0/th-extras/pull/14 + +repository head.hackage.ghc.haskell.org + url: https://ghc.gitlab.haskell.org/head.hackage/ + secure: True + key-threshold: 3 + root-keys: + f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89 + 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329 + 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d + + with-compiler: ghc-9.2.1 tests: true @@ -36,11 +52,17 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:07Z +index-state: 2021-12-12T08:11:07Z constraints: -- These plugins doesn't work on GHC92 yet - haskell-language-server +ignore-plugins-ghc-bounds -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy -retrie + haskell-language-server +ignore-plugins-ghc-bounds -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy -hlint -ormolu -floskell, + ghc-lib-parser ^>= 9.2, + attoparsec ^>= 0.14.3, + primitive-extras ==0.10.1.2, + -- these constraints are for head.hackage + aeson ==1.5.6.0, + primitive-unlifted ==0.1.3.0, allow-newer: Cabal, From c2335696df3ee0d5c27613c7f343cb5b17912215 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 18 Dec 2021 09:26:26 +0000 Subject: [PATCH 002/149] progress --- cabal-ghc921.project | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 000ac09ded..eeeeb08e16 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-12T08:11:07Z +index-state: 2021-12-18T00:00:00Z constraints: -- These plugins doesn't work on GHC92 yet @@ -60,9 +60,14 @@ constraints: ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, primitive-extras ==0.10.1.2, + ghc-exactprint >= 1.3, + retrie >= 1.2, + lens >= 5.0.1, -- these constraints are for head.hackage + primitive-unlifted < 1, aeson ==1.5.6.0, primitive-unlifted ==0.1.3.0, + -- lens == 5.0.1 allow-newer: Cabal, @@ -84,4 +89,10 @@ allow-newer: dependent-sum:constraints, diagrams:diagrams-core, Chart-diagrams:diagrams-core, - SVGFonts:diagrams-core + SVGFonts:diagrams-core, + + -- for head.hackage + primitive-unlifted:base + +allow-older: + primitive-extras:primitive-unlifted From e9327e4900cdd7b5b3e2b8ebb2963491cc9b0d5c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 18 Dec 2021 10:37:35 +0000 Subject: [PATCH 003/149] enable 9.2 in CI --- .github/workflows/build.yml | 7 +++++-- .github/workflows/caching.yml | 2 +- .github/workflows/hackage.yml | 1 - .github/workflows/test.yml | 22 +++++++++++++--------- 4 files changed, 19 insertions(+), 13 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 1e30d37a60..a3fa341c6d 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -17,7 +17,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ['9.0.1', '8.10.7', '8.10.6', '8.8.4', '8.6.5'] + ghc: ['9.2.1', '9.0.1', '8.10.7', '8.10.6', '8.8.4', '8.6.5'] os: [ubuntu-18.04, macOS-latest, windows-latest] cabal: ['3.6'] @@ -43,9 +43,12 @@ jobs: echo -e 'package blaze-textual\n flags: +integer-simple' >> cabal.project.local fi - - name: Use modified cabal.project for ghc9 + - name: Use modified cabal.project for ghc9.0 if: ${{ matrix.ghc == '9.0.1' }} run: cp cabal-ghc901.project cabal.project + - name: Use modified cabal.project for ghc9.2 + if: ${{ matrix.ghc == '9.2.1' }} + run: cp cabal-ghc921.project cabal.project - name: Shorten binary names run: | diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index b1a57c1906..e2e9bad711 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -61,7 +61,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] + ghc: ["9.2.1", "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] os: [ubuntu-latest, macOS-latest, windows-latest] cabal: ['3.6'] diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index c5b8e1a890..7e11955b5d 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -28,7 +28,6 @@ jobs: "hls-call-hierarchy-plugin", "hls-alternate-number-format-plugin", "hls-qualify-imported-names-plugin", "haskell-language-server"] - # Uncomment 9.0.1 when ghcide is buildable ghc: [ "9.0.1", "8.10.7", "8.8.4", diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 78658238bd..54a906955b 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -40,7 +40,7 @@ jobs: strategy: fail-fast: true matrix: - ghc: ["9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] + ghc: ["9.2.1", "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] os: [ubuntu-latest, macOS-latest] cabal: ['3.6'] include: @@ -96,6 +96,10 @@ jobs: name: (GHC 9.0.1) Use modified `cabal.project` run: | cp cabal-ghc901.project cabal.project + - if: matrix.ghc == '9.2.1' + name: (GHC 9.2.1) Use modified `cabal.project` + run: | + cp cabal-ghc921.project cabal.project - if: runner.os == 'Windows' && matrix.ghc == '8.8.4' name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults run: | @@ -188,12 +192,12 @@ jobs: run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" - - if: matrix.test && matrix.ghc != '9.0.1' + - if: matrix.test && matrix.ghc != '9.0.1' && matrix.ghc != '9.2.1' name: Test hls-brittany-plugin run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" - if: matrix.test - name: Test hls-class-plugin + name: Test hls-class-plugin && matrix.ghc != '9.2.1' run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" - if: matrix.test @@ -204,23 +208,23 @@ jobs: name: Test hls-haddock-comments-plugin run: cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-splice-plugin run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || cabal test hls-splice-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.0.1' + - if: matrix.test && matrix.ghc != '9.0.1' && matrix.ghc != '9.2.1' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.0.1' && !(matrix.os == 'ubuntu-latest' && matrix.ghc == '8.6.5') + - if: matrix.test && matrix.ghc != '9.0.1' && matrix.ghc != '9.2.1' && !(matrix.os == 'ubuntu-latest' && matrix.ghc == '8.6.5') name: Test hls-tactics-plugin test suite run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="$TEST_OPTS" @@ -240,7 +244,7 @@ jobs: name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="$TEST_OPTS" From a1e6af10c0a4723427c9199466d54d6e7c59134b Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 19 Dec 2021 18:19:18 +0000 Subject: [PATCH 004/149] Sort out some compatibility issues (#2511) --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 28 +++++++++++++++---- .../Development/IDE/GHC/Compat/Outputable.hs | 7 +++++ 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 634b530c8b..26bdc28b6d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -121,7 +121,9 @@ module Development.IDE.GHC.Compat.Core ( TyCoRep.CoercionTy ), pattern FunTy, +#if !MIN_VERSION_ghc(9,2,0) Development.IDE.GHC.Compat.Core.splitForAllTyCoVars, +#endif Development.IDE.GHC.Compat.Core.mkVisFunTys, Development.IDE.GHC.Compat.Core.mkInfForAllTys, -- * Specs @@ -234,7 +236,9 @@ module Development.IDE.GHC.Compat.Core ( Unlinked(..), Linkable(..), unload, +#if !MIN_VERSION_ghc(9,2,0) initDynLinker, +#endif -- * Hooks Hooks, runMetaHook, @@ -426,7 +430,7 @@ import GHC.Core.Coercion import GHC.Core.ConLike import GHC.Core.DataCon hiding (dataConExTyCoVars) import qualified GHC.Core.DataCon as DataCon -import GHC.Core.FamInstEnv +import GHC.Core.FamInstEnv hiding (pprFamInst) import GHC.Core.InstEnv import GHC.Types.Unique.FM #if MIN_VERSION_ghc(9,2,0) @@ -444,6 +448,7 @@ import GHC.Core.Type hiding (mkInfForAllTys, mkVisFunTys) import GHC.Core.Unify import GHC.Core.Utils + #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env #else @@ -460,6 +465,9 @@ import GHC.Driver.Pipeline import GHC.Driver.Plugins import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Driver.Session as DynFlags +#if MIN_VERSION_ghc(9,2,0) +import GHC.Hs (HsParsedModule(..)) +#endif #if !MIN_VERSION_ghc(9,2,0) import GHC.Hs #endif @@ -480,6 +488,7 @@ import GHC.Parser.Lexer import GHC.Linker.Loader import GHC.Linker.Types import GHC.Platform.Ways +import GHC.Runtime.Context (InteractiveImport(..)) #else import GHC.Runtime.Linker #endif @@ -497,6 +506,9 @@ import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, import GHC.Tc.Utils.TcType as TcType import qualified GHC.Types.Avail as Avail #if MIN_VERSION_ghc(9,2,0) +import GHC.Types.Fixity (LexicalFixity(..)) +#endif +#if MIN_VERSION_ghc(9,2,0) import GHC.Types.Meta #endif import GHC.Types.Basic @@ -510,6 +522,7 @@ import GHC.Types.Name.Set import GHC.Types.SourceFile (HscSource (..), SourceModified (..)) import GHC.Types.SourceText +import GHC.Types.Target (Target(..), TargetId(..)) import GHC.Types.TyThing import GHC.Types.TyThing.Ppr #else @@ -532,10 +545,12 @@ import GHC.Unit.Module hiding (ModLocation (..), UnitId, toUnitId) import qualified GHC.Unit.Module as Module #if MIN_VERSION_ghc(9,2,0) +import GHC.Unit.Module.Graph (mkModuleGraph) import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (IfaceExport) +import GHC.Unit.Module.ModIface (IfaceExport, ModIface(..), ModIface_(..)) +import GHC.Unit.Module.ModSummary (ModSummary(..)) #endif import GHC.Unit.State (ModuleOrigin (..)) import GHC.Utils.Error (Severity (..)) @@ -658,6 +673,11 @@ import Data.List (isSuffixOf) import System.FilePath #endif + +#if MIN_VERSION_ghc(9,2,0) +import Language.Haskell.Syntax.Expr +#endif + #if !MIN_VERSION_ghc(9,0,0) type BufSpan = () type BufPos = () @@ -806,11 +826,9 @@ mkInfForAllTys = mkInvForAllTys #endif +#if !MIN_VERSION_ghc(9,2,0) splitForAllTyCoVars :: Type -> ([TyCoVar], Type) splitForAllTyCoVars = -#if MIN_VERSION_ghc(9,2,0) - TcType.splitForAllTyCoVars -#else splitForAllTys #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index e3b6d2a453..7605b76536 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -37,6 +37,7 @@ import GHC.Parser.Errors import qualified GHC.Parser.Errors.Ppr as Ppr import qualified GHC.Types.Error as Error import GHC.Types.Name.Ppr +import GHC.Types.Name.Reader import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Unit.State @@ -154,7 +155,13 @@ type PsError = ErrMsg mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault = +#if MIN_VERSION_ghc(9,2,0) + -- GHC 9.2.1 version + -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified + mkPrintUnqualified unsafeGlobalDynFlags +#else HscTypes.mkPrintUnqualified unsafeGlobalDynFlags +#endif mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc mkWarnMsg = From a92845af347c854d0912cae613b326a8e0d88f2c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 19:05:19 +0000 Subject: [PATCH 005/149] fix mkPrintUnqualifiedDefault --- .../Development/IDE/GHC/Compat/Outputable.hs | 9 ++++---- .../Development/IDE/Plugin/CodeAction/Args.hs | 10 ++++++++- .../src/Development/IDE/Plugin/TypeLenses.hs | 21 +++++++++++-------- 3 files changed, 26 insertions(+), 14 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 7605b76536..354d013d07 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -31,6 +31,7 @@ module Development.IDE.GHC.Compat.Outputable ( #if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session import GHC.Parser.Errors @@ -153,14 +154,14 @@ type PsWarning = ErrMsg type PsError = ErrMsg #endif -mkPrintUnqualifiedDefault :: GlobalRdrEnv -> PrintUnqualified -mkPrintUnqualifiedDefault = +mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified +mkPrintUnqualifiedDefault env = #if MIN_VERSION_ghc(9,2,0) -- GHC 9.2.1 version -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified - mkPrintUnqualified unsafeGlobalDynFlags + mkPrintUnqualified (hsc_unit_env env) #else - HscTypes.mkPrintUnqualified unsafeGlobalDynFlags + HscTypes.mkPrintUnqualified (hsc_dflags env) #endif mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index 21f9fc5832..da56246f29 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -54,9 +54,10 @@ runGhcideCodeAction :: LSP.MonadLsp Config m => IdeState -> MessageParams TextDo runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext {_diagnostics = List diags}) codeAction = do let mbFile = toNormalizedFilePath' <$> uriToFilePath uri runRule key = runAction ("GhcideCodeActions." <> show key) state $ runMaybeT $ MaybeT (pure mbFile) >>= MaybeT . use key + caaGhcSession <- onceIO $ runRule GhcSession caaExportsMap <- onceIO $ - runRule GhcSession >>= \case + caaGhcSession >>= \case Just env -> do pkgExports <- envPackageExports env localExports <- readTVarIO (exportsMap $ shakeExtras state) @@ -134,6 +135,7 @@ instance (ToTextEdit a, ToTextEdit b) => ToTextEdit (Either a b) where data CodeActionArgs = CodeActionArgs { caaExportsMap :: IO ExportsMap, + caaGhcSession :: IO (Maybe HscEnvEq), caaIdeOptions :: IO IdeOptions, caaParsedModule :: IO (Maybe ParsedModule), caaContents :: IO (Maybe T.Text), @@ -267,3 +269,9 @@ instance ToCodeAction r => ToCodeAction (Maybe GlobalBindingTypeSigsResult -> r) instance ToCodeAction r => ToCodeAction (GlobalBindingTypeSigsResult -> r) where toCodeAction = toCodeAction2 caaGblSigs + +instance ToCodeAction r => ToCodeAction (Maybe HscEnvEq -> r) where + toCodeAction = toCodeAction1 caaGhcSession + +instance ToCodeAction r => ToCodeAction (Maybe HscEnv -> r) where + toCodeAction = toCodeAction1 ((fmap.fmap.fmap) hscEnv caaGhcSession) diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index b29be7ab03..115d8ae3b5 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -26,7 +26,8 @@ import qualified Data.Text as T import Development.IDE (GhcSession (..), HscEnvEq (hscEnv), RuleResult, Rules, define, - srcSpanToRange) + srcSpanToRange, + tmrModSummary) import Development.IDE.Core.Compile (TcModuleResult (..)) import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), TypeCheck (TypeCheck)) @@ -97,6 +98,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif mode <- usePropertyLsp #mode pId properties fmap (Right . List) $ case uriToFilePath' uri of Just (toNormalizedFilePath' -> filePath) -> liftIO $ do + env <- fmap hscEnv <$> runAction "codeLens.GhcSession" ideState (use GhcSession filePath) tmr <- runAction "codeLens.TypeCheck" ideState (use TypeCheck filePath) bindings <- runAction "codeLens.GetBindings" ideState (use GetBindings filePath) gblSigs <- runAction "codeLens.GetGlobalBindingTypeSigs" ideState (use GetGlobalBindingTypeSigs filePath) @@ -123,9 +125,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif case mode of Always -> pure (catMaybes $ generateLensForGlobal <$> gblSigs') - <> generateLensFromDiags (suggestLocalSignature False tmr bindings) -- we still need diagnostics for local bindings + <> generateLensFromDiags (suggestLocalSignature False env tmr bindings) -- we still need diagnostics for local bindings Exported -> pure $ catMaybes $ generateLensForGlobal <$> filter gbExported gblSigs' - Diagnostics -> generateLensFromDiags $ suggestSignature False gblSigs tmr bindings + Diagnostics -> generateLensFromDiags $ suggestSignature False env gblSigs tmr bindings Nothing -> pure [] generateLens :: PluginId -> Range -> T.Text -> WorkspaceEdit -> CodeLens @@ -140,9 +142,9 @@ commandHandler _ideState wedit = do -------------------------------------------------------------------------------- -suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])] -suggestSignature isQuickFix mGblSigs mTmr mBindings diag = - suggestGlobalSignature isQuickFix mGblSigs diag <> suggestLocalSignature isQuickFix mTmr mBindings diag +suggestSignature :: Bool -> Maybe HscEnv -> Maybe GlobalBindingTypeSigsResult -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])] +suggestSignature isQuickFix env mGblSigs mTmr mBindings diag = + suggestGlobalSignature isQuickFix mGblSigs diag <> suggestLocalSignature isQuickFix env mTmr mBindings diag suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, [TextEdit])] suggestGlobalSignature isQuickFix mGblSigs Diagnostic{_message, _range} @@ -156,19 +158,20 @@ suggestGlobalSignature isQuickFix mGblSigs Diagnostic{_message, _range} [(title, [action])] | otherwise = [] -suggestLocalSignature :: Bool -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])] -suggestLocalSignature isQuickFix mTmr mBindings Diagnostic{_message, _range = _range@Range{..}} +suggestLocalSignature :: Bool -> Maybe HscEnv -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])] +suggestLocalSignature isQuickFix mEnv mTmr mBindings Diagnostic{_message, _range = _range@Range{..}} | Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, [identifier]) <- (T.unwords . T.words $ _message) =~~ ("Polymorphic local binding with no type signature: (.*) ::" :: T.Text) , Just bindings <- mBindings + , Just env <- mEnv , localScope <- getFuzzyScope bindings _start _end , -- we can't use srcspan to lookup scoped bindings, because the error message reported by GHC includes the entire binding, instead of simply the name Just (name, ty) <- find (\(x, _) -> printName x == T.unpack identifier) localScope >>= \(name, mTy) -> (name,) <$> mTy , Just TcModuleResult{tmrTypechecked = TcGblEnv{tcg_rdr_env, tcg_sigs}} <- mTmr , -- not a top-level thing, to avoid duplication not $ name `elemNameSet` tcg_sigs - , tyMsg <- printSDocQualifiedUnsafe (mkPrintUnqualifiedDefault tcg_rdr_env) $ pprSigmaType ty + , tyMsg <- printSDocQualifiedUnsafe (mkPrintUnqualifiedDefault env tcg_rdr_env) $ pprSigmaType ty , signature <- T.pack $ printName name <> " :: " <> tyMsg , startCharacter <- _character _start , startOfLine <- Position (_line _start) startCharacter From 1ea186ca9ace1aad9ca138cb2743834e5091d8c8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 19:05:31 +0000 Subject: [PATCH 006/149] fix qualified idents --- ghcide/src/Development/IDE/GHC/Compat/Units.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 61f8d82644..b2c227a286 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -131,12 +131,12 @@ initUnits env = do let cached_unit_dbs = hsc_unit_dbs env (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags1 cached_unit_dbs - dflags <- updatePlatformConstants dflags1 mconstants + dflags <- DynFlags.updatePlatformConstants dflags1 mconstants let unit_env = UnitEnv { ue_platform = targetPlatform dflags - , ue_namever = ghcNameVersion dflags + , ue_namever = DynFlags.ghcNameVersion dflags , ue_home_unit = home_unit , ue_units = unit_state } From e62a05efa0cbeba5d1e83e98e6c6c203fd151ce4 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 19:46:57 +0000 Subject: [PATCH 007/149] Fix a few more ghc compats --- .../session-loader/Development/IDE/Session.hs | 5 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 197 ++++++++++-------- .../src/Development/IDE/GHC/Compat/Parser.hs | 5 +- 3 files changed, 114 insertions(+), 93 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 4488c23cb8..4fb7756f94 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -532,10 +532,7 @@ cradleToOptsAndLibDir logger cradle file = do emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv emptyHscEnv nc libDir = do env <- runGhc (Just libDir) getSession - when (Compat.ghcVersion < Compat.GHC90) $ - -- This causes ghc9 to crash with the error: - -- Couldn't find a target code interpreter. Try with -fexternal-interpreter - initDynLinker env + initDynLinker env pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env) data TargetDetails = TargetDetails diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 26bdc28b6d..56d76aac94 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -235,10 +235,8 @@ module Development.IDE.GHC.Compat.Core ( -- * Linker Unlinked(..), Linkable(..), - unload, -#if !MIN_VERSION_ghc(9,2,0) + Linker.unload, initDynLinker, -#endif -- * Hooks Hooks, runMetaHook, @@ -311,6 +309,11 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Iface.Syntax, #if MIN_VERSION_ghc(9,2,0) + module GHC.Hs.Decls, + module GHC.Hs.Extension, + module GHC.Hs.ImpExp, + module GHC.Hs.Pat, + module GHC.Hs.Type, module Language.Haskell.Syntax.Expr, #endif @@ -421,30 +424,31 @@ module Development.IDE.GHC.Compat.Core ( import qualified GHC #if MIN_VERSION_ghc(9,0,0) -import GHC.Builtin.Names hiding (Unique, printName) +import GHC.Builtin.Names hiding (Unique, printName) import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Builtin.Utils import GHC.Core.Class import GHC.Core.Coercion import GHC.Core.ConLike -import GHC.Core.DataCon hiding (dataConExTyCoVars) -import qualified GHC.Core.DataCon as DataCon -import GHC.Core.FamInstEnv hiding (pprFamInst) +import GHC.Core.DataCon hiding (dataConExTyCoVars) +import qualified GHC.Core.DataCon as DataCon +import GHC.Core.FamInstEnv hiding (pprFamInst) import GHC.Core.InstEnv import GHC.Types.Unique.FM #if MIN_VERSION_ghc(9,2,0) -import GHC.Core.Multiplicity (scaledThing) +import GHC.Core.Multiplicity (scaledThing) #else -import GHC.Core.Ppr.TyThing hiding (pprFamInst) -import GHC.Core.TyCo.Rep (scaledThing) +import GHC.Core.Ppr.TyThing hiding (pprFamInst) +import GHC.Core.TyCo.Rep (scaledThing) #endif import GHC.Core.PatSyn import GHC.Core.Predicate import GHC.Core.TyCo.Ppr -import qualified GHC.Core.TyCo.Rep as TyCoRep +import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Core.TyCon -import GHC.Core.Type hiding (mkInfForAllTys, mkVisFunTys) +import GHC.Core.Type hiding (mkInfForAllTys, + mkVisFunTys) import GHC.Core.Unify import GHC.Core.Utils @@ -456,17 +460,22 @@ import GHC.Driver.Finder import GHC.Driver.Types import GHC.Driver.Ways #endif -import GHC.Driver.CmdLine (Warn (..)) +import GHC.Driver.CmdLine (Warn (..)) import GHC.Driver.Hooks import GHC.Driver.Main import GHC.Driver.Monad import GHC.Driver.Phases import GHC.Driver.Pipeline import GHC.Driver.Plugins -import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags #if MIN_VERSION_ghc(9,2,0) -import GHC.Hs (HsParsedModule(..)) +import GHC.Hs (HsParsedModule (..)) +import GHC.Hs.Decls hiding (FunDep) +import GHC.Hs.Extension +import GHC.Hs.ImpExp +import GHC.Hs.Pat +import GHC.Hs.Type #endif #if !MIN_VERSION_ghc(9,2,0) import GHC.Hs @@ -475,21 +484,22 @@ import GHC.HsToCore.Docs import GHC.HsToCore.Expr import GHC.HsToCore.Monad import GHC.Iface.Load -import GHC.Iface.Make (mkFullIface, mkIfaceTc, - mkPartialIface) +import GHC.Iface.Make (mkFullIface, mkIfaceTc, + mkPartialIface) import GHC.Iface.Recomp import GHC.Iface.Syntax import GHC.Iface.Tidy import GHC.IfaceToCore import GHC.Parser -import GHC.Parser.Header hiding (getImports) -import GHC.Parser.Lexer +import GHC.Parser.Header hiding (getImports) #if MIN_VERSION_ghc(9,2,0) -import GHC.Linker.Loader +import GHC.Linker.Loader as Linker import GHC.Linker.Types +import GHC.Parser.Lexer hiding (initParserState) import GHC.Platform.Ways -import GHC.Runtime.Context (InteractiveImport(..)) +import GHC.Runtime.Context (InteractiveImport (..)) #else +import GHC.Parser.Lexer import GHC.Runtime.Linker #endif import GHC.Rename.Names @@ -498,80 +508,82 @@ import GHC.Runtime.Interpreter import GHC.Tc.Instance.Family import GHC.Tc.Module import GHC.Tc.Types -import GHC.Tc.Types.Evidence hiding ((<.>)) +import GHC.Tc.Types.Evidence hiding ((<.>)) import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, - MonadFix (..), MonadIO (..), allM, - anyM, concatMapM, mapMaybeM, (<$>)) -import GHC.Tc.Utils.TcType as TcType -import qualified GHC.Types.Avail as Avail +import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, + MonadFix (..), MonadIO (..), + allM, anyM, concatMapM, + mapMaybeM, (<$>)) +import GHC.Tc.Utils.TcType as TcType +import qualified GHC.Types.Avail as Avail #if MIN_VERSION_ghc(9,2,0) -import GHC.Types.Fixity (LexicalFixity(..)) +import GHC.Types.Fixity (LexicalFixity (..)) #endif #if MIN_VERSION_ghc(9,2,0) import GHC.Types.Meta #endif import GHC.Types.Basic import GHC.Types.Id -import GHC.Types.Name hiding (varName) +import GHC.Types.Name hiding (varName) import GHC.Types.Name.Cache import GHC.Types.Name.Env import GHC.Types.Name.Reader #if MIN_VERSION_ghc(9,2,0) import GHC.Types.Name.Set -import GHC.Types.SourceFile (HscSource (..), - SourceModified (..)) +import GHC.Types.SourceFile (HscSource (..), + SourceModified (..)) import GHC.Types.SourceText -import GHC.Types.Target (Target(..), TargetId(..)) +import GHC.Types.Target (Target (..), TargetId (..)) import GHC.Types.TyThing import GHC.Types.TyThing.Ppr #else import GHC.Types.Name.Set #endif -import GHC.Types.SrcLoc (BufPos, BufSpan, - SrcLoc (UnhelpfulLoc), - SrcSpan (UnhelpfulSpan)) -import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.SrcLoc (BufPos, BufSpan, + SrcLoc (UnhelpfulLoc), + SrcSpan (UnhelpfulSpan)) +import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique.Supply -import GHC.Types.Var (Var (varName), setTyVarUnique, - setVarUnique) +import GHC.Types.Var (Var (varName), setTyVarUnique, + setVarUnique) #if MIN_VERSION_ghc(9,2,0) import GHC.Unit.Finder import GHC.Unit.Home.ModInfo #endif -import GHC.Unit.Info (PackageName (..)) -import GHC.Unit.Module hiding (ModLocation (..), UnitId, - addBootSuffixLocnOut, moduleUnit, - toUnitId) -import qualified GHC.Unit.Module as Module +import GHC.Unit.Info (PackageName (..)) +import GHC.Unit.Module hiding (ModLocation (..), UnitId, + addBootSuffixLocnOut, moduleUnit, + toUnitId) +import qualified GHC.Unit.Module as Module #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Module.Graph (mkModuleGraph) +import GHC.Unit.Module.Graph (mkModuleGraph) import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (IfaceExport, ModIface(..), ModIface_(..)) -import GHC.Unit.Module.ModSummary (ModSummary(..)) -#endif -import GHC.Unit.State (ModuleOrigin (..)) -import GHC.Utils.Error (Severity (..)) -import GHC.Utils.Panic hiding (try) -import qualified GHC.Utils.Panic.Plain as Plain +import GHC.Unit.Module.ModIface (IfaceExport, ModIface (..), + ModIface_ (..)) +import GHC.Unit.Module.ModSummary (ModSummary (..)) +#endif +import GHC.Unit.State (ModuleOrigin (..)) +import GHC.Utils.Error (Severity (..)) +import GHC.Utils.Panic hiding (try) +import qualified GHC.Utils.Panic.Plain as Plain #else import qualified Avail -import BasicTypes hiding (Version) +import BasicTypes hiding (Version) import Class -import CmdLineParser (Warn (..)) +import CmdLineParser (Warn (..)) import ConLike import CoreUtils -import DataCon hiding (dataConExTyCoVars) +import DataCon hiding (dataConExTyCoVars) import qualified DataCon import DriverPhases import DriverPipeline import DsExpr -import DsMonad hiding (foldrM) -import DynFlags hiding (ExposePackage) +import DsMonad hiding (foldrM) +import DynFlags hiding (ExposePackage) import qualified DynFlags -import ErrUtils hiding (logInfo, mkWarnMsg) +import ErrUtils hiding (logInfo, mkWarnMsg) import ExtractDocs import FamInst import FamInstEnv @@ -581,7 +593,7 @@ import GHC.Hs #endif import GHCi import GhcMonad -import HeaderInfo hiding (getImports) +import HeaderInfo hiding (getImports) import Hooks import HscMain import HscTypes @@ -595,81 +607,83 @@ import HsExtension import HsImpExp import HsLit import HsPat -import HsSyn hiding (wildCardName) -import HsTypes hiding (wildCardName) +import HsSyn hiding (wildCardName) +import HsTypes hiding (wildCardName) import HsUtils #endif import Id import IfaceSyn import InstEnv -import Lexer hiding (getSrcLoc) -import Linker +import Lexer hiding (getSrcLoc) +import qualified Linker import LoadIface import MkIface -import Module hiding (ModLocation (..), UnitId, - addBootSuffixLocnOut, moduleUnitId) +import Module hiding (ModLocation (..), UnitId, + addBootSuffixLocnOut, + moduleUnitId) import qualified Module -import Name hiding (varName) +import Name hiding (varName) import NameCache import NameEnv import NameSet import Packages #if MIN_VERSION_ghc(8,8,0) -import Panic hiding (try) -import qualified PlainPanic as Plain +import Panic hiding (try) +import qualified PlainPanic as Plain #else -import Panic hiding (GhcException, try) -import qualified Panic as Plain +import Panic hiding (GhcException, try) +import qualified Panic as Plain #endif import Parser import PatSyn #if MIN_VERSION_ghc(8,8,0) import Plugins #endif -import PprTyThing hiding (pprFamInst) +import PprTyThing hiding (pprFamInst) import PrelInfo -import PrelNames hiding (Unique, printName) +import PrelNames hiding (Unique, printName) import RdrName import RnNames import RnSplice import qualified SrcLoc import TcEnv -import TcEvidence hiding ((<.>)) +import TcEvidence hiding ((<.>)) import TcIface import TcRnDriver -import TcRnMonad hiding (Applicative (..), IORef, - MonadFix (..), MonadIO (..), allM, - anyM, concatMapM, foldrM, - mapMaybeM, (<$>)) +import TcRnMonad hiding (Applicative (..), IORef, + MonadFix (..), MonadIO (..), + allM, anyM, concatMapM, foldrM, + mapMaybeM, (<$>)) import TcRnTypes -import TcType hiding (mkVisFunTys) +import TcType hiding (mkVisFunTys) import qualified TcType import TidyPgm import qualified TyCoRep import TyCon -import Type hiding (mkVisFunTys) +import Type hiding (mkVisFunTys) import TysPrim import TysWiredIn import Unify import UniqFM import UniqSupply -import Var (Var (varName), setTyVarUnique, - setVarUnique, varType) +import Var (Var (varName), setTyVarUnique, + setVarUnique, varType) #if MIN_VERSION_ghc(8,10,0) -import Coercion (coercionKind) +import Coercion (coercionKind) import Predicate -import SrcLoc (SrcLoc (UnhelpfulLoc), - SrcSpan (UnhelpfulSpan)) +import SrcLoc (SrcLoc (UnhelpfulLoc), + SrcSpan (UnhelpfulSpan)) #else -import SrcLoc (RealLocated, SrcLoc (UnhelpfulLoc), - SrcSpan (UnhelpfulSpan)) +import SrcLoc (RealLocated, + SrcLoc (UnhelpfulLoc), + SrcSpan (UnhelpfulSpan)) #endif #endif #if !MIN_VERSION_ghc(8,8,0) -import Data.List (isSuffixOf) +import Data.List (isSuffixOf) import System.FilePath #endif @@ -883,3 +897,12 @@ type PlainGhcException = Plain.PlainGhcException #else type PlainGhcException = Plain.GhcException #endif + +initDynLinker :: HscEnv -> IO () +initDynLinker = +#if !MIN_VERSION_ghc(9,0,0) + Linker.initDynLinker +#else + -- It errors out in GHC 9.0 and doesn't exist in 9.2 + const $ return () +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 0a2375cd99..f8ae0f23d1 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -22,17 +22,18 @@ module Development.IDE.GHC.Compat.Parser ( mkApiAnns, -- * API Annotations Anno.AnnKeywordId(..), +#if !MIN_VERSION_ghc(9,2,0) Anno.AnnotationComment(..), +#endif ) where #if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Parser.Annotation as Anno import qualified GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc (PsSpan (..)) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Config as Config import GHC.Parser.Lexer hiding (initParserState) -#else -import qualified GHC.Parser.Annotation as Anno #endif #else import qualified ApiAnnotation as Anno From 4d1bc3b7c36c65af6d8806a2504d22cdec386b32 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 19:47:05 +0000 Subject: [PATCH 008/149] Add new orphans --- ghcide/src/Development/IDE/GHC/Orphans.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index a04fd1e86d..01a3670633 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -93,6 +93,14 @@ instance NFData FastString where rnf = rwhnf #endif +#if MIN_VERSION_ghc(9,2,0) +instance Ord FastString where + compare a b = if a == b then EQ else compare (fs_sbs a) (fs_sbs b) + +instance NFData (SrcSpanAnn' a) where + rnf = rwhnf +#endif + instance NFData ParsedModule where rnf = rwhnf From 664ec28c5e246aecb9b82890b2da094f32dd91ad Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 20:08:18 +0000 Subject: [PATCH 009/149] Fix runtime APIs --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 23 +++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 56d76aac94..6b1f7718be 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -500,11 +500,11 @@ import GHC.Platform.Ways import GHC.Runtime.Context (InteractiveImport (..)) #else import GHC.Parser.Lexer -import GHC.Runtime.Linker +import qualified GHC.Runtime.Linker as Linker #endif import GHC.Rename.Names import GHC.Rename.Splice -import GHC.Runtime.Interpreter +import qualified GHC.Runtime.Interpreter as GHCi import GHC.Tc.Instance.Family import GHC.Tc.Module import GHC.Tc.Types @@ -591,7 +591,7 @@ import Finder #if MIN_VERSION_ghc(8,10,0) import GHC.Hs #endif -import GHCi +import qualified GHCi import GhcMonad import HeaderInfo hiding (getImports) import Hooks @@ -898,7 +898,7 @@ type PlainGhcException = Plain.PlainGhcException type PlainGhcException = Plain.GhcException #endif -initDynLinker :: HscEnv -> IO () +initDynLinker, initObjLinker :: HscEnv -> IO () initDynLinker = #if !MIN_VERSION_ghc(9,0,0) Linker.initDynLinker @@ -906,3 +906,18 @@ initDynLinker = -- It errors out in GHC 9.0 and doesn't exist in 9.2 const $ return () #endif + +initObjLinker env = +#if !MIN_VERSION_ghc(9,2,0) + GHCi.initObjLinker env +#else + GHCi.initObjLinker (GHCi.hscInterp env) +#endif + +loadDLL :: HscEnv -> String -> IO (Maybe String) +loadDLL env = +#if !MIN_VERSION_ghc(9,2,0) + GHCi.loadDLL env +#else + GHCi.loadDLL (GHCi.hscInterp env) +#endif From f4a6a1bf7d9b21e78ade530001c153cbc86de10a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Dec 2021 23:32:25 +0000 Subject: [PATCH 010/149] HsParsedModule --- ghcide/src/Development/IDE/Core/Compile.hs | 2 +- ghcide/src/Development/IDE/Core/Rules.hs | 3 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 15 ++-- .../src/Development/IDE/GHC/Compat/Parser.hs | 69 +++++++++++++------ .../src/Development/IDE/GHC/Compat/Plugins.hs | 3 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 1 - .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 6 +- .../src/Ide/Plugin/QualifyImportedNames.hs | 9 ++- 8 files changed, 70 insertions(+), 38 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 7b002f08fa..25f6a782a8 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -921,7 +921,7 @@ parseFileContents env customPreprocessor filename ms = do -- filter them out: srcs2 <- liftIO $ filterM doesFileExist srcs1 - let pm = mkParsedModule ms parsed' srcs2 hpm_annotations + let pm = ParsedModule ms parsed' srcs2 hpm_annotations warnings = diagFromErrMsgs "parser" dflags warns pure (warnings ++ preproc_warnings, pm) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 756edad54c..b2495b5e07 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -106,8 +106,7 @@ 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.Env -import Development.IDE.GHC.Compat.Core hiding +import Development.IDE.GHC.Compat hiding (parseModule, TargetId(..), loadInterface, diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 6b1f7718be..682ad4c059 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -149,8 +149,7 @@ module Development.IDE.GHC.Compat.Core ( -- * TcGblEnv TcGblEnv(..), -- * Parsing and LExer types - HsParsedModule(..), - GHC.ParsedModule(..), + HsModule(..), GHC.ParsedSource, GHC.RenamedSource, -- * Compilation Main @@ -195,6 +194,9 @@ module Development.IDE.GHC.Compat.Core ( pattern RealSrcLoc, SrcLoc.SrcLoc(SrcLoc.UnhelpfulLoc), BufSpan, +#if MIN_VERSION_ghc(9,2,0) + SrcSpanAnn', +#endif SrcLoc.leftmost_smallest, SrcLoc.containsSpan, SrcLoc.mkGeneralSrcSpan, @@ -277,6 +279,9 @@ module Development.IDE.GHC.Compat.Core ( -- * Panic PlainGhcException, panic, + -- * Other + GHC.CoreModule(..), + GHC.SafeHaskellMode(..), -- * Util Module re-exports #if MIN_VERSION_ghc(9,0,0) module GHC.Builtin.Names, @@ -310,6 +315,7 @@ module Development.IDE.GHC.Compat.Core ( #if MIN_VERSION_ghc(9,2,0) module GHC.Hs.Decls, + module GHC.Hs.Doc, module GHC.Hs.Extension, module GHC.Hs.ImpExp, module GHC.Hs.Pat, @@ -470,8 +476,9 @@ import GHC.Driver.Plugins import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Driver.Session as DynFlags #if MIN_VERSION_ghc(9,2,0) -import GHC.Hs (HsParsedModule (..)) +import GHC.Hs (HsModule (..), SrcSpanAnn') import GHC.Hs.Decls hiding (FunDep) +import GHC.Hs.Doc import GHC.Hs.Extension import GHC.Hs.ImpExp import GHC.Hs.Pat @@ -672,7 +679,7 @@ import Var (Var (varName), setTyVarUnique, #if MIN_VERSION_ghc(8,10,0) import Coercion (coercionKind) import Predicate -import SrcLoc (SrcLoc (UnhelpfulLoc), +import SrcLoc (Located, SrcLoc (UnhelpfulLoc), SrcSpan (UnhelpfulSpan)) #else import SrcLoc (RealLocated, diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index f8ae0f23d1..5d81800183 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} -- | Parser compaibility module. module Development.IDE.GHC.Compat.Parser ( @@ -17,8 +18,21 @@ module Development.IDE.GHC.Compat.Parser ( #if MIN_VERSION_ghc(9,0,0) PsSpan(..), #endif - mkHsParsedModule, - mkParsedModule, +#if MIN_VERSION_ghc(9,2,0) + pattern HsParsedModule, + type GHC.HsParsedModule, + Development.IDE.GHC.Compat.Parser.hpm_module, + Development.IDE.GHC.Compat.Parser.hpm_src_files, + Development.IDE.GHC.Compat.Parser.hpm_annotations, + pattern ParsedModule, + type GHC.ParsedModule, + Development.IDE.GHC.Compat.Parser.pm_mod_summary, + Development.IDE.GHC.Compat.Parser.pm_extra_src_files, + Development.IDE.GHC.Compat.Parser.pm_annotations, +#else + GHC.HsParsedModule(..), + GHC.ParsedModule(..), +#endif mkApiAnns, -- * API Annotations Anno.AnnKeywordId(..), @@ -28,15 +42,25 @@ module Development.IDE.GHC.Compat.Parser ( ) where #if MIN_VERSION_ghc(9,0,0) +#if !MIN_VERSION_ghc(9,2,0) +import qualified GHC.Driver.Types as GHC +#endif import qualified GHC.Parser.Annotation as Anno import qualified GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc (PsSpan (..)) #if MIN_VERSION_ghc(9,2,0) +import GHC (pm_extra_src_files, + pm_mod_summary, + pm_parsed_source) +import qualified GHC import qualified GHC.Driver.Config as Config +import GHC.Hs (hpm_module, hpm_src_files) +import qualified GHC.Hs as GHC import GHC.Parser.Lexer hiding (initParserState) #endif #else import qualified ApiAnnotation as Anno +import qualified HscTypes as GHC import Lexer import qualified SrcLoc #endif @@ -45,6 +69,7 @@ import Development.IDE.GHC.Compat.Util #if !MIN_VERSION_ghc(9,2,0) import qualified Data.Map as Map +import qualified GHC #endif #if !MIN_VERSION_ghc(9,0,0) @@ -79,27 +104,31 @@ type ApiAnns = () type ApiAnns = Anno.ApiAnns #endif - -mkHsParsedModule :: ParsedSource -> [FilePath] -> ApiAnns -> HsParsedModule -mkHsParsedModule parsed fps hpm_annotations = - HsParsedModule - parsed - fps -#if !MIN_VERSION_ghc(9,2,0) - hpm_annotations +#if MIN_VERSION_ghc(9,2,0) +pattern HsParsedModule :: Located HsModule -> [FilePath] -> ApiAnns -> GHC.HsParsedModule +pattern HsParsedModule + { hpm_module + , hpm_src_files + , hpm_annotations + } <- ( (,()) -> (GHC.HsParsedModule{..}, hpm_annotations)) + where + HsParsedModule hpm_module hpm_src_files hpm_annotations = + GHC.HsParsedModule hpm_module hpm_src_files #endif -mkParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> ParsedModule -mkParsedModule ms parsed extra_src_files _hpm_annotations = - ParsedModule { - pm_mod_summary = ms - , pm_parsed_source = parsed - , pm_extra_src_files = extra_src_files -#if !MIN_VERSION_ghc(9,2,0) - , pm_annotations = _hpm_annotations +#if MIN_VERSION_ghc(9,2,0) +pattern ParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> GHC.ParsedModule +pattern ParsedModule + { pm_mod_summary + , pm_parsed_source + , pm_extra_src_files + , pm_annotations + } <- ( (,()) -> (GHC.ParsedModule{..}, pm_annotations)) + where + ParsedModule ms parsed extra_src_files _anns = + GHC.ParsedModule { pm_mod_summary = ms , pm_parsed_source = parsed , pm_extra_src_files = extra_src_files } #endif - } mkApiAnns :: PState -> ApiAnns #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 6621b70e9c..6fd5834f63 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -17,7 +17,6 @@ module Development.IDE.GHC.Compat.Plugins ( #endif ) where -import GHC #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Env as Env @@ -51,7 +50,7 @@ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do dflags #endif applyPluginAction - (mkHsParsedModule parsed [] hpm_annotations) + (HsParsedModule parsed [] hpm_annotations) initializePlugins :: HscEnv -> IO HscEnv initializePlugins env = do diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 01a3670633..d49affa91a 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -25,7 +25,6 @@ import qualified StringBuffer as SB import Unique (getKey) #endif -import GHC import Retrie.ExactPrint (Annotated) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 27a5846f4d..07c1d0ac16 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -55,7 +55,7 @@ import Refact.Apply #ifdef HLINT_ON_GHC_LIB import Data.List (nub) -import Development.IDE.GHC.Compat.Core (BufSpan, +import Development.IDE.GHC.Compat (BufSpan, DynFlags, extensionFlags, ms_hspp_opts, @@ -79,7 +79,7 @@ import System.IO (IOMode (Wri withFile) import System.IO.Temp #else -import Development.IDE.GHC.Compat.Core hiding +import Development.IDE.GHC.Compat hiding (setEnv) import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions) import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) @@ -109,7 +109,7 @@ import GHC.Generics (Associativi Generic) import Text.Regex.TDFA.Text () -import Development.IDE.GHC.Compat.Core (WarningFlag (Opt_WarnUnrecognisedPragmas), +import Development.IDE.GHC.Compat (WarningFlag (Opt_WarnUnrecognisedPragmas), wopt) import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits), NextPragmaInfo (NextPragmaInfo), diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index 2aa31fcf5b..af27f15c92 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -28,19 +28,18 @@ import Development.IDE.Core.RuleTypes (GetFileContents (GetFileCont import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (IdeState, use) import Development.IDE.GHC.Compat (ContextInfo (Use), - Identifier, - IdentifierDetails (IdentifierDetails, identInfo), - RefMap, Span) -import Development.IDE.GHC.Compat.Core (GenLocated (L), GhcPs, + GenLocated (..), GhcPs, GlobalRdrElt (GRE, gre_imp, gre_name), GlobalRdrEnv, HsModule (hsmodImports), + Identifier, + IdentifierDetails (IdentifierDetails, identInfo), ImpDeclSpec (ImpDeclSpec, is_as, is_dloc, is_qual), ImportSpec (ImpSpec), LImportDecl, ModuleName, Name, NameEnv, OccName, ParsedModule (ParsedModule, pm_parsed_source), - SrcSpan, + RefMap, Span, SrcSpan, TcGblEnv (tcg_rdr_env), emptyUFM, globalRdrEnvElts, lookupNameEnv, From 4c84520f7fe48fdcd268115753c311c06e680ed4 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 20 Dec 2021 00:20:24 +0000 Subject: [PATCH 011/149] export GHC.Hs.Utils --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 682ad4c059..c7b80c8df6 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -320,6 +320,7 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Hs.ImpExp, module GHC.Hs.Pat, module GHC.Hs.Type, + module GHC.Hs.Utils, module Language.Haskell.Syntax.Expr, #endif @@ -483,6 +484,7 @@ import GHC.Hs.Extension import GHC.Hs.ImpExp import GHC.Hs.Pat import GHC.Hs.Type +import GHC.Hs.Utils #endif #if !MIN_VERSION_ghc(9,2,0) import GHC.Hs From f6623bcee7d6de9bd7a1e307a682bb8be1dfa49e Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 20 Dec 2021 14:50:23 +0530 Subject: [PATCH 012/149] 9.2 compat for unloading and hie file generation --- ghcide/src/Development/IDE/Core/Compile.hs | 12 ++++++---- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 22 +++++++++++++++++-- 2 files changed, 28 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 25f6a782a8..9bb364304a 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -325,7 +325,7 @@ generateObjectCode session summary guts = do withWarnings "object" $ \tweak -> do let env' = tweak (hscSetFlags (ms_hspp_opts summary) session) target = platformDefaultBackend (hsc_dflags env') - newFlags = setBackend target $ updOptLevel 0 $ (hsc_dflags env') { outputFile = Just dot_o } + newFlags = setBackend target $ updOptLevel 0 $ setOutputFile dot_o $ hsc_dflags env' session' = hscSetFlags newFlags session #if MIN_VERSION_ghc(9,0,1) (outputFilename, _mStub, _foreign_files, _cinfos) <- hscGenHardCode session' guts @@ -454,7 +454,7 @@ atomicFileWrite targetPath write = do generateHieAsts :: HscEnv -> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type)) generateHieAsts hscEnv tcm = - handleGenerationErrors' dflags "extended interface generation" $ runHsc hscEnv $ do + handleGenerationErrors' dflags "extended interface generation" $ runHsc hscEnv $ -- These varBinds use unitDataConId but it could be anything as the id name is not used -- during the hie file generation process. It's a workaround for the fact that the hie modules -- don't export an interface which allows for additional information to be added to hie files. @@ -465,9 +465,13 @@ generateHieAsts hscEnv tcm = top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind insts = tcg_insts ts :: [ClsInst] tcs = tcg_tcs ts :: [TyCon] - Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs + in +#if MIN_VERSION_ghc(9,2,0) + fmap (join . snd) $ liftIO $ initDs hscEnv ts $ +#endif + Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs #else - Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) + in Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) #endif where dflags = hsc_dflags hscEnv diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index c7b80c8df6..7cb51b4357 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -34,6 +34,7 @@ module Development.IDE.GHC.Compat.Core ( refLevelHoleFits, maxRefHoleFits, maxValidHoleFits, + setOutputFile, #if MIN_VERSION_ghc(8,8,0) CommandLineOption, #if !MIN_VERSION_ghc(9,2,0) @@ -237,7 +238,7 @@ module Development.IDE.GHC.Compat.Core ( -- * Linker Unlinked(..), Linkable(..), - Linker.unload, + unload, initDynLinker, -- * Hooks Hooks, @@ -502,7 +503,7 @@ import GHC.IfaceToCore import GHC.Parser import GHC.Parser.Header hiding (getImports) #if MIN_VERSION_ghc(9,2,0) -import GHC.Linker.Loader as Linker +import qualified GHC.Linker.Loader as Linker import GHC.Linker.Types import GHC.Parser.Lexer hiding (initParserState) import GHC.Platform.Ways @@ -930,3 +931,20 @@ loadDLL env = #else GHCi.loadDLL (GHCi.hscInterp env) #endif + +unload :: HscEnv -> [Linkable] -> IO () +unload hsc_env linkables = + Linker.unload +#if MIN_VERSION_ghc(9,2,0) + (GHCi.hscInterp hsc_env) +#endif + hsc_env linkables + +setOutputFile :: FilePath -> DynFlags -> DynFlags +setOutputFile f d = d { +#if MIN_VERSION_ghc(9,2,0) + outputFile_ = Just f +#else + outputFile = Just f +#endif + } From c024d965e0e268ef61c78492453eaf109941458b Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 20 Dec 2021 11:45:05 +0000 Subject: [PATCH 013/149] hlint fix --- ghcide/src/Development/IDE/GHC/Compat/Parser.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 5d81800183..696647b96b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} +{-# HLINT ignore "Unused LANGUAGE pragma" #-} -- | Parser compaibility module. module Development.IDE.GHC.Compat.Parser ( From b430b9449b9a559692ee2d94e8af98a51201a3c6 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 20 Dec 2021 19:25:52 +0530 Subject: [PATCH 014/149] Remove 'setupFinderCache' as its never actually used --- ghcide/src/Development/IDE/Core/Compile.hs | 25 ---------------------- 1 file changed, 25 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 9bb364304a..4c419325df 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -27,7 +27,6 @@ module Development.IDE.Core.Compile , loadHieFile , loadInterface , loadModulesHome - , setupFinderCache , getDocsBatch , lookupName ,mergeEnvs) where @@ -654,30 +653,6 @@ handleGenerationErrors' dflags source action = . (("Error during " ++ T.unpack source) ++) . show @SomeException ] --- | Initialise the finder cache, dependencies should be topologically --- sorted. -setupFinderCache :: [ModSummary] -> HscEnv -> IO HscEnv -setupFinderCache mss session = do - - -- Make modules available for others that import them, - -- by putting them in the finder cache. - let ims = map (installedModule (homeUnitId_ $ hsc_dflags session) . moduleName . ms_mod) mss - ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) mss ims - -- set the target and module graph in the session - graph = mkModuleGraph mss - - -- We have to create a new IORef here instead of modifying the existing IORef as - -- it is shared between concurrent compilations. - prevFinderCache <- readIORef $ hsc_FC session - let newFinderCache = - foldl' - (\fc (im, ifr) -> GHC.extendInstalledModuleEnv fc im ifr) prevFinderCache - $ zip ims ifrs - newFinderCacheVar <- newIORef $! newFinderCache - - pure $ session { hsc_FC = newFinderCacheVar, hsc_mod_graph = graph } - - -- | Load modules, quickly. Input doesn't need to be desugared. -- A module must be loaded before dependent modules can be typechecked. -- This variant of loadModuleHome will *never* cause recompilation, it just From 0a411e27916e8660e9c991f3ec61552a1c0b06a2 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 20 Dec 2021 21:03:26 +0530 Subject: [PATCH 015/149] 9.2 compat for Development.IDE.Core.Compile --- ghcide/src/Development/IDE/Core/Compile.hs | 73 ++++++++++++++++++---- ghcide/src/Development/IDE/GHC/Compat.hs | 13 ++++ 2 files changed, 74 insertions(+), 12 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 4c419325df..d788e8d221 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -68,6 +68,10 @@ import GHC.Tc.Gen.Splice import TcSplice #endif +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Types.Error as Error +#endif + import Control.Exception (evaluate) import Control.Exception.Safe import Control.Lens hiding (List) @@ -80,6 +84,7 @@ import qualified Data.DList as DL import Data.IORef import Data.List.Extra import qualified Data.Map.Strict as Map +import qualified Data.IntMap.Strict as IntMap import Data.Maybe import qualified Data.Text as T import Data.Time (UTCTime, getCurrentTime) @@ -102,6 +107,7 @@ import Data.Coerce import Data.Functor import qualified Data.HashMap.Strict as HashMap import Data.Map (Map) +import Data.IntMap (IntMap) import Data.Tuple.Extra (dupe) import Data.Unique as Unique import Development.IDE.Core.Tracing (withTrace) @@ -676,6 +682,15 @@ mergeEnvs env extraModSummaries extraMods envs = do prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs let ims = map (Compat.installedModule (homeUnitId_ $ hsc_dflags env) . moduleName . ms_mod) extraModSummaries ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims + -- We don't do any instantiation for backpack at this point of time, so it is OK to use + -- 'extendModSummaryNoDeps'. + -- This may have to change in the future. + module_graph_nodes = +#if MIN_VERSION_ghc(9,2,0) + map extendModSummaryNoDeps $ +#endif + extraModSummaries ++ nubOrdOn ms_mod (concatMap (mgModSummaries . hsc_mod_graph) envs) + newFinderCache <- newIORef $ foldl' (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) prevFinderCache @@ -683,7 +698,7 @@ mergeEnvs env extraModSummaries extraMods envs = do return $ loadModulesHome extraMods $ env{ hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, hsc_FC = newFinderCache, - hsc_mod_graph = mkModuleGraph $ extraModSummaries ++ nubOrdOn ms_mod (concatMap (mgModSummaries . hsc_mod_graph) envs) + hsc_mod_graph = mkModuleGraph module_graph_nodes } where mergeUDFM = plusUDFM_C combineModules @@ -732,8 +747,9 @@ getModSummaryFromImports env fp modTime contents = do implicit_prelude = xopt LangExt.ImplicitPrelude dflags implicit_imports = mkPrelImports mod main_loc implicit_prelude imps + convImport (L _ i) = (fmap sl_fs (ideclPkgQual i) - , ideclName i) + , reLoc $ ideclName i) srcImports = map convImport src_idecls textualImports = map convImport (implicit_imports ++ ordinary_imps) @@ -805,13 +821,23 @@ parseHeader dflags filename contents = do case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of #if MIN_VERSION_ghc(8,10,0) PFailed pst -> - throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags + throwE $ diagFromErrMsgs "parser" dflags +#if MIN_VERSION_ghc(9,2,0) + $ fmap pprError +#endif + $ getErrorMessages pst +#if !MIN_VERSION_ghc(9,2,0) + dflags +#endif #else PFailed _ locErr msgErr -> throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr #endif POk pst rdr_module -> do - let (warns, errs) = getMessages pst dflags + let (warns, errs) = getMessages pst +#if !MIN_VERSION_ghc(9,2,0) + dflags +#endif -- Just because we got a `POk`, it doesn't mean there -- weren't errors! To clarify, the GHC parser -- distinguishes between fatal and non-fatal @@ -842,7 +868,15 @@ parseFileContents env customPreprocessor filename ms = do contents = fromJust $ ms_hspp_buf ms case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of #if MIN_VERSION_ghc(8,10,0) - PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags + PFailed pst -> throwE + $ diagFromErrMsgs "parser" dflags +#if MIN_VERSION_ghc(9,2,0) + $ fmap pprError +#endif + $ getErrorMessages pst +#if !MIN_VERSION_ghc(9,2,0) + $ dflags +#endif #else PFailed _ locErr msgErr -> throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr @@ -850,7 +884,14 @@ parseFileContents env customPreprocessor filename ms = do POk pst rdr_module -> let hpm_annotations = mkApiAnns pst - (warns, errs) = getMessages pst dflags + (warns, errs) = id +#if MIN_VERSION_ghc(9,2,0) + $ bimap (fmap pprWarning) (fmap pprError) +#endif + $ getMessages pst +#if !MIN_VERSION_ghc(9,2,0) + $ dflags +#endif in do -- Just because we got a `POk`, it doesn't mean there @@ -977,9 +1018,9 @@ getDocsBatch :: HscEnv -> Module -- ^ a moudle where the names are in scope -> [Name] - -> IO [Either String (Maybe HsDocString, Map.Map Int HsDocString)] + -> IO [Either String (Maybe HsDocString, IntMap HsDocString)] getDocsBatch hsc_env _mod _names = do - ((_warns,errs), res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name -> + (msgs, res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name -> case nameModule_maybe name of Nothing -> return (Left $ NameHasNoModule name) Just mod -> do @@ -987,13 +1028,21 @@ getDocsBatch hsc_env _mod _names = do , mi_decl_docs = DeclDocMap dmap , mi_arg_docs = ArgDocMap amap } <- loadModuleInterface "getModuleInterface" mod - if isNothing mb_doc_hdr && Map.null dmap && Map.null amap + if isNothing mb_doc_hdr && Map.null dmap && null amap then pure (Left (NoDocsInIface mod $ compiled name)) - else pure (Right ( Map.lookup name dmap - , Map.findWithDefault Map.empty name amap)) + else pure (Right ( Map.lookup name dmap , +#if !MIN_VERSION_ghc(9,2,0) + IntMap.fromAscList $ Map.toAscList $ +#endif + Map.findWithDefault mempty name amap)) case res of Just x -> return $ map (first $ T.unpack . showGhc) x - Nothing -> throwErrors errs + Nothing -> throwErrors +#if MIN_VERSION_ghc(9,2,0) + $ Error.getErrorMessages msgs +#else + $ snd msgs +#endif where throwErrors = liftIO . throwIO . mkSrcErr compiled n = diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 79840ba37f..a98704138f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -15,11 +15,17 @@ module Development.IDE.GHC.Compat( setUpTypedHoles, upNameCache, disableWarningsAsErrors, + reLoc, #if !MIN_VERSION_ghc(9,0,1) RefMap, #endif +#if MIN_VERSION_ghc(9,2,0) + extendModSummaryNoDeps, + emsModSummary, +#endif + nodeInfo', getNodeIds, @@ -72,6 +78,7 @@ import Development.IDE.GHC.Compat.Util import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) #if MIN_VERSION_ghc(9,2,0) +import GHC.Unit.Module.ModSummary import GHC.Driver.Env as Env import GHC.Unit.Module.ModIface #else @@ -115,6 +122,11 @@ import Data.List (foldl') import qualified Data.Set as S #endif +#if !MIN_VERSION_ghc(9,2,0) +reLoc :: Located a -> Located a +reLoc = id +#endif + #if !MIN_VERSION_ghc(8,8,0) hPutStringBuffer :: Handle -> StringBuffer -> IO () hPutStringBuffer hdl (StringBuffer buf len cur) @@ -128,6 +140,7 @@ supportsHieFiles = True hieExportNames :: HieFile -> [(SrcSpan, Name)] hieExportNames = nameListFromAvails . hie_exports + upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c #if MIN_VERSION_ghc(8,8,0) upNameCache = updNameCache From 3a834f62ca007e47c82f343612de3a7b652bd937 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 20 Dec 2021 21:29:35 +0530 Subject: [PATCH 016/149] Stub out 'getDocumentation' on GHC 9.2 (Requires a reimplementation in terms of in-tree annotations) --- ghcide/src/Development/IDE/Spans/Documentation.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 8afe4f72fe..ed993fb7ec 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -39,7 +39,12 @@ mkDocMap -> TcGblEnv -> IO DocAndKindMap mkDocMap env rm this_mod = - do let (_ , DeclDocMap this_docs, _) = extractDocs this_mod + do +#if MIN_VERSION_ghc(9,2,0) + (_ , DeclDocMap this_docs, _) <- extractDocs this_mod +#else + let (_ , DeclDocMap this_docs, _) = extractDocs this_mod +#endif d <- foldrM getDocs (mkNameEnv $ M.toList $ fmap (`SpanDocString` SpanDocUris Nothing Nothing) this_docs) names k <- foldrM getType (tcg_type_env this_mod) names pure $ DKMap d k @@ -108,7 +113,12 @@ getDocumentation -- may be edge cases where it is very wrong). -- TODO : Build a version of GHC exactprint to extract this information -- more accurately. +-- TODO : Implement this for GHC 9.2 with in-tree annotations +-- (alternatively, just remove it and rely soley on GHC's parsing) getDocumentation sources targetName = fromMaybe [] $ do +#if MIN_VERSION_ghc(9,2,0) + Nothing +#else -- Find the module the target is defined in. targetNameSpan <- realSpan $ getLoc targetName tc <- @@ -170,6 +180,7 @@ docHeaders = mapMaybe (\(L _ x) -> wrk x) then Just $ T.pack s else Nothing _ -> Nothing +#endif -- These are taken from haskell-ide-engine's Haddock plugin From a1fd2ea9239602e4dff003091853500916ac22c0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 20 Dec 2021 17:47:11 +0000 Subject: [PATCH 017/149] Expose binds --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 7cb51b4357..bdead61ba5 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -322,6 +322,7 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Hs.Pat, module GHC.Hs.Type, module GHC.Hs.Utils, + module Language.Haskell.Syntax.Binds, module Language.Haskell.Syntax.Expr, #endif @@ -699,6 +700,7 @@ import System.FilePath #if MIN_VERSION_ghc(9,2,0) +import Language.Haskell.Syntax.Binds import Language.Haskell.Syntax.Expr #endif From 6b9b2886647ba3cb8b66e0f62c7e410a83a74c2a Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 21 Dec 2021 03:26:07 +0530 Subject: [PATCH 018/149] Remove a bit of CPP by refactoring it into Compat layer --- ghcide/src/Development/IDE/Core/Compile.hs | 36 +++++----------------- ghcide/src/Development/IDE/GHC/Compat.hs | 28 +++++++++++++++++ 2 files changed, 35 insertions(+), 29 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index d788e8d221..13f99ddb2a 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -821,23 +821,14 @@ parseHeader dflags filename contents = do case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of #if MIN_VERSION_ghc(8,10,0) PFailed pst -> - throwE $ diagFromErrMsgs "parser" dflags -#if MIN_VERSION_ghc(9,2,0) - $ fmap pprError -#endif - $ getErrorMessages pst -#if !MIN_VERSION_ghc(9,2,0) - dflags -#endif + throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages' pst dflags #else PFailed _ locErr msgErr -> throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr #endif POk pst rdr_module -> do - let (warns, errs) = getMessages pst -#if !MIN_VERSION_ghc(9,2,0) - dflags -#endif + let (warns, errs) = getMessages' pst dflags + -- Just because we got a `POk`, it doesn't mean there -- weren't errors! To clarify, the GHC parser -- distinguishes between fatal and non-fatal @@ -848,9 +839,9 @@ parseHeader dflags filename contents = do -- errors are those from which a parse tree just can't -- be produced. unless (null errs) $ - throwE $ diagFromErrMsgs "parser" dflags (fmap pprError errs) + throwE $ diagFromErrMsgs "parser" dflags errs - let warnings = diagFromErrMsgs "parser" dflags (fmap pprWarning warns) + let warnings = diagFromErrMsgs "parser" dflags warns return (warnings, rdr_module) -- | Given a buffer, flags, and file path, produce a @@ -870,13 +861,7 @@ parseFileContents env customPreprocessor filename ms = do #if MIN_VERSION_ghc(8,10,0) PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags -#if MIN_VERSION_ghc(9,2,0) - $ fmap pprError -#endif - $ getErrorMessages pst -#if !MIN_VERSION_ghc(9,2,0) - $ dflags -#endif + $ getErrorMessages' pst dflags #else PFailed _ locErr msgErr -> throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr @@ -884,14 +869,7 @@ parseFileContents env customPreprocessor filename ms = do POk pst rdr_module -> let hpm_annotations = mkApiAnns pst - (warns, errs) = id -#if MIN_VERSION_ghc(9,2,0) - $ bimap (fmap pprWarning) (fmap pprError) -#endif - $ getMessages pst -#if !MIN_VERSION_ghc(9,2,0) - $ dflags -#endif + (warns, errs) = getMessages' pst dflags in do -- Just because we got a `POk`, it doesn't mean there diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index a98704138f..e218bcac95 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -16,6 +16,8 @@ module Development.IDE.GHC.Compat( upNameCache, disableWarningsAsErrors, reLoc, + getErrorMessages', + getMessages', #if !MIN_VERSION_ghc(9,0,1) RefMap, @@ -117,6 +119,7 @@ import Data.IORef import qualified Data.Map as Map import Data.List (foldl') +import Data.Bifunctor #if MIN_VERSION_ghc(9,0,0) import qualified Data.Set as S @@ -134,6 +137,31 @@ hPutStringBuffer hdl (StringBuffer buf len cur) hPutBuf hdl ptr len #endif +#if MIN_VERSION_ghc(9,2,0) +type ErrMsg = MsgEnvelope DecoratedSDoc +type WarnMsg = MsgEnvelope DecoratedSDoc +#endif + +getErrorMessages' :: PState -> DynFlags -> Bag ErrMsg +getErrorMessages' pst dflags = +#if MIN_VERSION_ghc(9,2,0) + fmap pprError $ +#endif + getErrorMessages pst +#if !MIN_VERSION_ghc(9,2,0) + dflags +#endif + +getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg) +getMessages' pst dflags = +#if MIN_VERSION_ghc(9,2,0) + bimap (fmap pprWarning) (fmap pprError) $ +#endif + getMessages pst +#if !MIN_VERSION_ghc(9,2,0) + dflags +#endif + supportsHieFiles :: Bool supportsHieFiles = True From 3fec58d6efa1ab9271e318e124b7da7942daf015 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 20 Dec 2021 19:21:39 +0000 Subject: [PATCH 019/149] Progress on ghc-exactprint stuff The Exactprint module compiles, but code actions are the next focus. --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 53 ++++++- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 150 +++++++++++++----- 2 files changed, 163 insertions(+), 40 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index bdead61ba5..92cd62b961 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -186,6 +186,11 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.Located, SrcLoc.unLoc, getLoc, + getLocA, + locA, + LocatedAn, + AnnListItem, + NameAnn, SrcLoc.RealLocated, SrcLoc.GenLocated(..), SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan), @@ -197,6 +202,7 @@ module Development.IDE.GHC.Compat.Core ( BufSpan, #if MIN_VERSION_ghc(9,2,0) SrcSpanAnn', + GHC.SrcAnn, #endif SrcLoc.leftmost_smallest, SrcLoc.containsSpan, @@ -207,6 +213,7 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.realSrcLocSpan, SrcLoc.realSrcSpanStart, SrcLoc.realSrcSpanEnd, + isSubspanOfA, SrcLoc.isSubspanOf, SrcLoc.wiredInSrcSpan, SrcLoc.mkSrcSpan, @@ -316,14 +323,14 @@ module Development.IDE.GHC.Compat.Core ( #if MIN_VERSION_ghc(9,2,0) module GHC.Hs.Decls, + module GHC.Hs.Expr, module GHC.Hs.Doc, module GHC.Hs.Extension, module GHC.Hs.ImpExp, module GHC.Hs.Pat, module GHC.Hs.Type, module GHC.Hs.Utils, - module Language.Haskell.Syntax.Binds, - module Language.Haskell.Syntax.Expr, + module Language.Haskell.Syntax, #endif module GHC.Rename.Names, @@ -482,6 +489,7 @@ import qualified GHC.Driver.Session as DynFlags import GHC.Hs (HsModule (..), SrcSpanAnn') import GHC.Hs.Decls hiding (FunDep) import GHC.Hs.Doc +import GHC.Hs.Expr import GHC.Hs.Extension import GHC.Hs.ImpExp import GHC.Hs.Pat @@ -700,8 +708,7 @@ import System.FilePath #if MIN_VERSION_ghc(9,2,0) -import Language.Haskell.Syntax.Binds -import Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax hiding (FunDep) #endif #if !MIN_VERSION_ghc(9,0,0) @@ -950,3 +957,41 @@ setOutputFile f d = d { outputFile = Just f #endif } + +#if MIN_VERSION_ghc(9,2,0) +isSubspanOfA :: GHC.LocatedAn la a -> GHC.LocatedAn lb b -> Bool +isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLocA a) (GHC.getLocA b) +#else +isSubspanOfA :: Located a -> Located b -> Bool +isSubspanOfA = isSubspanOf +#endif + +#if MIN_VERSION_ghc(9,2,0) +type LocatedAn a = GHC.LocatedAn a +#else +type LocatedAn a = Located +#endif + +#if MIN_VERSION_ghc(9,2,0) +locA = GHC.locA +#else +locA = id +#endif + +#if MIN_VERSION_ghc(9,2,0) +getLocA = GHC.getLocA +#else +getLocA = GHC.getLoc +#endif + +#if MIN_VERSION_ghc(9,2,0) +type AnnListItem = GHC.AnnListItem +#else +type AnnListItem = SrcLoc.SrcSpan +#endif + +#if MIN_VERSION_ghc(9,2,0) +type NameAnn = GHC.NameAnn +#else +type NameAnn = SrcLoc.SrcSpan +#endif diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 2f081cdedb..198cda50de 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} module Development.IDE.GHC.ExactPrint ( Graft(..), @@ -18,7 +21,9 @@ module Development.IDE.GHC.ExactPrint graftSmallestDeclsWithM, transform, transformM, +#if !MIN_VERSION_ghc(9,2,0) useAnnotatedSource, +#endif annotateParsedSource, getAnnotatedParsedSourceRule, GetAnnotatedParsedSource(..), @@ -26,9 +31,11 @@ module Development.IDE.GHC.ExactPrint ExceptStringT (..), Annotated(..), TransformT, +#if !MIN_VERSION_ghc(9,2,0) Anns, Annotate, setPrecedingLinesT, +#endif -- * Helper function eqSrcSpan, ) @@ -81,7 +88,11 @@ data GetAnnotatedParsedSource = GetAnnotatedParsedSource instance Hashable GetAnnotatedParsedSource instance NFData GetAnnotatedParsedSource +#if MIN_VERSION_ghc(9,2,0) +type instance RuleResult GetAnnotatedParsedSource = ParsedSource +#else type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource +#endif -- | Get the latest version of the annotated parse source with comments. getAnnotatedParsedSourceRule :: Rules () @@ -89,9 +100,15 @@ getAnnotatedParsedSourceRule = define $ \GetAnnotatedParsedSource nfp -> do pm <- use GetParsedModuleWithComments nfp return ([], fmap annotateParsedSource pm) +#if MIN_VERSION_ghc(9,2,0) +annotateParsedSource :: ParsedModule -> ParsedSource +annotateParsedSource (ParsedModule _ ps _ _) = ps +#else annotateParsedSource :: ParsedModule -> Annotated ParsedSource annotateParsedSource = fixAnns +#endif +#if !MIN_VERSION_ghc(9,2,0) useAnnotatedSource :: String -> IdeState -> @@ -99,6 +116,8 @@ useAnnotatedSource :: IO (Maybe (Annotated ParsedSource)) useAnnotatedSource herald state nfp = runAction herald state (use GetAnnotatedParsedSource nfp) +#endif + ------------------------------------------------------------------------------ {- | A transformation for grafting source trees together. Use the semigroup @@ -214,8 +233,8 @@ needsParensSpace _ = mempty ast@, or this is a no-op. -} graft' :: - forall ast a. - (Data a, ASTElement ast) => + forall ast a l. + (Data a, Typeable l, ASTElement l ast) => -- | Do we need to insert a space before this grafting? In do blocks, the -- answer is no, or we will break layout. But in function applications, -- the answer is yes, or the function call won't get its argument. Yikes! @@ -223,21 +242,26 @@ graft' :: -- More often the answer is yes, so when in doubt, use that. Bool -> SrcSpan -> - Located ast -> + LocatedAn l ast -> Graft (Either String) a graft' needs_space dst val = Graft $ \dflags a -> do +#if MIN_VERSION_ghc(9,2,0) + val' <- annotate dflags needs_space val +#else (anns, val') <- annotate dflags needs_space val modifyAnnsT $ mappend anns +#endif pure $ everywhere' ( mkT $ \case - (L src _ :: Located ast) - | src `eqSrcSpan` dst -> val' + (L src _ :: LocatedAn l ast) + | (locA src) `eqSrcSpan` dst -> val' l -> l ) a + -- | Like 'graft', but specialized to 'LHsExpr', and intelligently inserts -- parentheses if they're necessary. graftExpr :: @@ -254,12 +278,11 @@ graftExpr dst val = Graft $ \dflags a -> do dflags a - getNeedsSpaceAndParenthesize :: - (ASTElement ast, Data a) => + (ASTElement l ast, Data a) => SrcSpan -> a -> - (Bool, Located ast -> Located ast) + (Bool, LocatedAn l ast -> LocatedAn l ast) getNeedsSpaceAndParenthesize dst a = -- Traverse the tree, looking for our replacement node. But keep track of -- the context (parent HsExpr constructor) we're in while we do it. This @@ -267,7 +290,7 @@ getNeedsSpaceAndParenthesize dst a = let (needs_parens, needs_space) = everythingWithContext (Nothing, Nothing) (<>) ( mkQ (mempty, ) $ \x s -> case x of - (L src _ :: LHsExpr GhcPs) | src `eqSrcSpan` dst -> + (L src _ :: LHsExpr GhcPs) | (locA src) `eqSrcSpan` dst -> (s, s) L _ x' -> (mempty, Just *** Just $ needsParensSpace x') ) a @@ -291,40 +314,54 @@ graftExprWithM dst trans = Graft $ \dflags a -> do ( mkM $ \case val@(L src _ :: LHsExpr GhcPs) - | src `eqSrcSpan` dst -> do + | (locA src) `eqSrcSpan` dst -> do mval <- trans val case mval of Just val' -> do +#if MIN_VERSION_ghc(9,2,0) + val'' <- + hoistTransform (either Fail.fail pure) + (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val')) + pure val'' +#else (anns, val'') <- hoistTransform (either Fail.fail pure) - (annotate @(HsExpr GhcPs) dflags needs_space (mk_parens val')) + (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val')) modifyAnnsT $ mappend anns pure val'' +#endif Nothing -> pure val l -> pure l ) a graftWithM :: - forall ast m a. - (Fail.MonadFail m, Data a, ASTElement ast) => + forall ast m a l. + (Fail.MonadFail m, Data a, Typeable l, ASTElement l ast) => SrcSpan -> - (Located ast -> TransformT m (Maybe (Located ast))) -> + (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))) -> Graft m a graftWithM dst trans = Graft $ \dflags a -> do everywhereM' ( mkM $ \case - val@(L src _ :: Located ast) - | src `eqSrcSpan` dst -> do + val@(L src _ :: LocatedAn l ast) + | (locA src) `eqSrcSpan` dst -> do mval <- trans val case mval of Just val' -> do +#if MIN_VERSION_ghc(9,2,0) + val'' <- + hoistTransform (either Fail.fail pure) $ + annotate dflags True $ maybeParensAST val' + pure val'' +#else (anns, val'') <- hoistTransform (either Fail.fail pure) $ annotate dflags True $ maybeParensAST val' modifyAnnsT $ mappend anns pure val'' +#endif Nothing -> pure val l -> pure l ) @@ -368,7 +405,7 @@ graftDecls dst decs0 = Graft $ \dflags a -> do annotateDecl dflags decl let go [] = DL.empty go (L src e : rest) - | src `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest + | (locA src) `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest | otherwise = DL.singleton (L src e) <> go rest modifyDeclsT (pure . DL.toList . go) a @@ -381,7 +418,7 @@ graftSmallestDeclsWithM :: graftSmallestDeclsWithM dst toDecls = Graft $ \dflags a -> do let go [] = pure DL.empty go (e@(L src _) : rest) - | dst `isSubspanOf` src = toDecls e >>= \case + | dst `isSubspanOf` (locA src) = toDecls e >>= \case Just decs0 -> do decs <- forM decs0 $ \decl -> annotateDecl dflags decl @@ -399,7 +436,7 @@ graftDeclsWithM :: graftDeclsWithM dst toDecls = Graft $ \dflags a -> do let go [] = pure DL.empty go (e@(L src _) : rest) - | src `eqSrcSpan` dst = toDecls e >>= \case + | (locA src) `eqSrcSpan` dst = toDecls e >>= \case Just decs0 -> do decs <- forM decs0 $ \decl -> hoistTransform (either Fail.fail pure) $ @@ -410,9 +447,9 @@ graftDeclsWithM dst toDecls = Graft $ \dflags a -> do modifyDeclsT (fmap DL.toList . go) a -class (Data ast, Outputable ast) => ASTElement ast where - parseAST :: Parser (Located ast) - maybeParensAST :: Located ast -> Located ast +class (Data ast, Typeable l, Outputable l, Outputable ast) => ASTElement l ast | ast -> l where + parseAST :: Parser (LocatedAn l ast) + maybeParensAST :: LocatedAn l ast -> LocatedAn l ast {- | Construct a 'Graft', replacing the node at the given 'SrcSpan' with the given @Located ast@. The node at that position must already be a @Located ast@, or this is a no-op. @@ -421,16 +458,16 @@ class (Data ast, Outputable ast) => ASTElement ast where forall a. (Data a) => SrcSpan -> - Located ast -> + LocatedAn l ast -> Graft (Either String) a graft dst = graft' True dst . maybeParensAST -instance p ~ GhcPs => ASTElement (HsExpr p) where +instance p ~ GhcPs => ASTElement AnnListItem (HsExpr p) where parseAST = parseExpr maybeParensAST = parenthesize graft = graftExpr -instance p ~ GhcPs => ASTElement (Pat p) where +instance p ~ GhcPs => ASTElement AnnListItem (Pat p) where #if __GLASGOW_HASKELL__ == 808 parseAST = fmap (fmap $ right $ second dL) . parsePattern maybeParensAST = dL . parenthesizePat appPrec . unLoc @@ -439,41 +476,53 @@ instance p ~ GhcPs => ASTElement (Pat p) where maybeParensAST = parenthesizePat appPrec #endif -instance p ~ GhcPs => ASTElement (HsType p) where +instance p ~ GhcPs => ASTElement AnnListItem (HsType p) where parseAST = parseType maybeParensAST = parenthesizeHsType appPrec -instance p ~ GhcPs => ASTElement (HsDecl p) where +instance p ~ GhcPs => ASTElement AnnListItem (HsDecl p) where parseAST = parseDecl maybeParensAST = id -instance p ~ GhcPs => ASTElement (ImportDecl p) where +instance p ~ GhcPs => ASTElement AnnListItem (ImportDecl p) where parseAST = parseImport maybeParensAST = id -instance ASTElement RdrName where +instance ASTElement NameAnn RdrName where parseAST df fp = parseWith df fp parseIdentifier maybeParensAST = id ------------------------------------------------------------------------------ +#if !MIN_VERSION_ghc(9,2,0) -- | Dark magic I stole from retrie. No idea what it does. fixAnns :: ParsedModule -> Annotated ParsedSource fixAnns ParsedModule {..} = let ranns = relativiseApiAnns pm_parsed_source pm_annotations in unsafeMkA pm_parsed_source ranns 0 +#endif ------------------------------------------------------------------------------ -- | Given an 'LHSExpr', compute its exactprint annotations. -- Note that this function will throw away any existing annotations (and format) -annotate :: ASTElement ast => DynFlags -> Bool -> Located ast -> TransformT (Either String) (Anns, Located ast) +annotate :: (ASTElement l ast, Outputable l) +#if MIN_VERSION_ghc(9,2,0) + => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast) +#else + => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (_, LocatedAn l ast) +#endif annotate dflags needs_space ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast +#if MIN_VERSION_ghc(9,2,0) + expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered + pure expr' +#else (anns, expr') <- lift $ mapLeft show $ parseAST dflags uniq rendered let anns' = setPrecedingLines expr' 0 (bool 0 1 needs_space) anns - pure (anns', expr') + pure (anns',expr') +#endif -- | Given an 'LHsDecl', compute its exactprint annotations. annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs) @@ -489,6 +538,17 @@ annotateDecl dflags let set_matches matches = ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }} +#if MIN_VERSION_ghc(9,2,0) + alts' <- for alts $ \alt -> do + uniq <- show <$> uniqueSrcSpanT + let rendered = render dflags $ set_matches [alt] + lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case + (L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}})) + -> pure alt' + _ -> lift $ Left "annotateDecl: didn't parse a single FunBind match" + + pure $ L src $ set_matches alts' +#else (anns', alts') <- fmap unzip $ for alts $ \alt -> do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags $ set_matches [alt] @@ -499,13 +559,21 @@ annotateDecl dflags modifyAnnsT $ mappend $ fold anns' pure $ L src $ set_matches alts' +#endif annotateDecl dflags ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast +#if MIN_VERSION_ghc(9,2,0) + expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered + -- let anns' = setPrecedingLines expr' 1 0 anns + -- modifyAnnsT $ mappend anns' + pure expr' +#else (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered let anns' = setPrecedingLines expr' 1 0 anns modifyAnnsT $ mappend anns' pure expr' +#endif ------------------------------------------------------------------------------ @@ -525,3 +593,13 @@ parenthesize = parenthesizeHsExpr appPrec -- Ignores the (Maybe BufSpan) field of SrcSpan's. eqSrcSpan :: SrcSpan -> SrcSpan -> Bool eqSrcSpan l r = leftmost_smallest l r == EQ + +-- | Equality on SrcSpan's. +-- Ignores the (Maybe BufSpan) field of SrcSpan's. +#if MIN_VERSION_ghc(9,2,0) +eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool +eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ +#else +eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool +eqSrcSpan l r = leftmost_smallest l r == EQ +#endif From ff701a2905f0c353aa36c1e2ec18cdf6eaea5386 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 21 Dec 2021 13:56:08 +0530 Subject: [PATCH 020/149] Fix compile on 8.10 --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 3 ++- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 4 ++-- ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 92cd62b961..491ab82cb8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -963,7 +963,7 @@ isSubspanOfA :: GHC.LocatedAn la a -> GHC.LocatedAn lb b -> Bool isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLocA a) (GHC.getLocA b) #else isSubspanOfA :: Located a -> Located b -> Bool -isSubspanOfA = isSubspanOf +isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLoc a) (GHC.getLoc b) #endif #if MIN_VERSION_ghc(9,2,0) @@ -981,6 +981,7 @@ locA = id #if MIN_VERSION_ghc(9,2,0) getLocA = GHC.getLocA #else +getLocA :: HasSrcSpan a => a -> SrcSpan getLocA = GHC.getLoc #endif diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 198cda50de..9b9c491071 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -510,7 +510,7 @@ annotate :: (ASTElement l ast, Outputable l) #if MIN_VERSION_ghc(9,2,0) => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast) #else - => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (_, LocatedAn l ast) + => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (Anns, LocatedAn l ast) #endif annotate dflags needs_space ast = do uniq <- show <$> uniqueSrcSpanT @@ -601,5 +601,5 @@ eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ #else eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool -eqSrcSpan l r = leftmost_smallest l r == EQ +eqSrcSpanA l r = leftmost_smallest l r == EQ #endif diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index b79775c8c4..59f8d2d277 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -173,7 +173,7 @@ appendConstraint constraintT = go ] return $ L lTop $ HsQualTy noExtField context (L l other) -liftParseAST :: ASTElement ast => DynFlags -> String -> TransformT (Either String) (Located ast) +liftParseAST :: forall ast l. ASTElement l ast => DynFlags -> String -> TransformT (Either String) (Located ast) liftParseAST df s = case parseAST df "" s of Right (anns, x) -> modifyAnnsT (anns <>) $> x Left _ -> lift $ Left $ "No parse: " <> s From b9eb445162a91444e33792ca45c67057285dac6d Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 21 Dec 2021 17:17:12 +0530 Subject: [PATCH 021/149] 9.2 compat for CodeAction Exactprint --- ghcide/src/Development/IDE/GHC/Compat.hs | 4 + .../IDE/Plugin/CodeAction/ExactPrint.hs | 241 ++++++++++++++---- 2 files changed, 196 insertions(+), 49 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index e218bcac95..5422a9b251 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -16,6 +16,7 @@ module Development.IDE.GHC.Compat( upNameCache, disableWarningsAsErrors, reLoc, + reLocA, getErrorMessages', getMessages', @@ -128,6 +129,9 @@ import qualified Data.Set as S #if !MIN_VERSION_ghc(9,2,0) reLoc :: Located a -> Located a reLoc = id + +reLocA :: Located a -> Located a +reLocA = id #endif #if !MIN_VERSION_ghc(8,8,0) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 59f8d2d277..b173953726 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -2,12 +2,15 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} module Development.IDE.Plugin.CodeAction.ExactPrint ( Rewrite (..), rewriteToEdit, rewriteToWEdit, +#if !MIN_VERSION_ghc(9,2,0) transferAnn, +#endif -- * Utilities appendConstraint, @@ -33,12 +36,17 @@ import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), - Annotate) +#if !MIN_VERSION_ghc(9,2,0) + Annotate +#endif + ) import Development.IDE.Spans.Common import GHC.Exts (IsList (fromList)) import Language.Haskell.GHC.ExactPrint +#if !MIN_VERSION_ghc(9,2,0) import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey) +#endif import Language.LSP.Types ------------------------------------------------------------------------------ @@ -47,11 +55,19 @@ import Language.LSP.Types -- given 'ast'. data Rewrite where Rewrite :: +#if !MIN_VERSION_ghc(9,2,0) Annotate ast => +#else + ExactPrint (GenLocated (Anno ast) ast) => +#endif -- | The 'SrcSpan' that we want to rewrite SrcSpan -> -- | The ast that we want to graft +#if !MIN_VERSION_ghc(9,2,0) (DynFlags -> TransformT (Either String) (Located ast)) -> +#else + (DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)) -> +#endif Rewrite ------------------------------------------------------------------------------ @@ -59,23 +75,54 @@ data Rewrite where -- | Convert a 'Rewrite' into a list of '[TextEdit]'. rewriteToEdit :: DynFlags -> +#if !MIN_VERSION_ghc(9,2,0) Anns -> +#endif Rewrite -> Either String [TextEdit] -rewriteToEdit dflags anns (Rewrite dst f) = do - (ast, (anns, _), _) <- runTransformT anns $ do +rewriteToEdit dflags +#if !MIN_VERSION_ghc(9,2,0) + anns +#endif + (Rewrite dst f) = do + (ast, anns , _) <- runTransformT +#if !MIN_VERSION_ghc(9,2,0) + anns +#endif + $ do ast <- f dflags +#if !MIN_VERSION_ghc(9,2,0) ast <$ setEntryDPT ast (DP (0, 0)) +#else + pure ast +#endif let editMap = [ TextEdit (fromJust $ srcSpanToRange dst) $ - T.pack $ exactPrint ast anns + T.pack $ exactPrint ast +#if !MIN_VERSION_ghc(9,2,0) + (fst anns) +#endif ] pure editMap -- | Convert a 'Rewrite' into a 'WorkspaceEdit' -rewriteToWEdit :: DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit -rewriteToWEdit dflags uri anns r = do - edits <- rewriteToEdit dflags anns r +rewriteToWEdit :: DynFlags + -> Uri +#if !MIN_VERSION_ghc(9,2,0) + -> Anns +#endif + -> Rewrite + -> Either String WorkspaceEdit +rewriteToWEdit dflags uri +#if !MIN_VERSION_ghc(9,2,0) + anns +#endif + r = do + edits <- rewriteToEdit dflags +#if !MIN_VERSION_ghc(9,2,0) + anns +#endif + r return $ WorkspaceEdit { _changes = Just (fromList [(uri, List edits)]) @@ -87,14 +134,22 @@ rewriteToWEdit dflags uri anns r = do -- | Fix the parentheses around a type context fixParens :: - (Monad m, Data (HsType pass)) => + (Monad m, Data (HsType pass), pass ~ GhcPass p0) => +#if !MIN_VERSION_ghc(9,2,0) Maybe DeltaPos -> Maybe DeltaPos -> +#endif LHsContext pass -> TransformT m [LHsType pass] -fixParens openDP closeDP ctxt@(L _ elems) = do +fixParens +#if !MIN_VERSION_ghc(9,2,0) + openDP closeDP +#endif + ctxt@(L _ elems) = do -- Paren annotation for type contexts are usually quite screwed up -- we remove duplicates and fix negative DPs +#if !MIN_VERSION_ghc(9,2,0) + let parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)] modifyAnnsT $ Map.adjust ( \x -> @@ -108,11 +163,11 @@ fixParens openDP closeDP ctxt@(L _ elems) = do } ) (mkAnnKey ctxt) +#endif return $ map dropHsParTy elems where - parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)] - dropHsParTy :: LHsType pass -> LHsType pass + dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass) dropHsParTy (L _ (HsParTy _ ty)) = ty dropHsParTy other = other @@ -123,14 +178,23 @@ removeConstraint :: Rewrite removeConstraint toRemove = go where - go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite l $ \_ -> do + go :: LHsType GhcPs -> Rewrite +#if !MIN_VERSION_ghc(9,2,0) + go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do +#else + go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do +#endif let ctxt' = L l' $ filter (not . toRemove) ctxt +#if !MIN_VERSION_ghc(9,2,0) when ((toRemove <$> headMaybe ctxt) == Just True) $ setEntryDPT hst_body (DP (0, 0)) return $ L l $ it{hst_ctxt = ctxt'} +#else + return $ L l $ it{hst_ctxt = Just ctxt'} +#endif go (L _ (HsParTy _ ty)) = go ty go (L _ HsForAllTy{hst_body}) = go hst_body - go (L l other) = Rewrite l $ \_ -> return $ L l other + go (L l other) = Rewrite (locA l) $ \_ -> return $ L l other -- | Append a constraint at the end of a type context. -- If no context is present, a new one will be created. @@ -142,26 +206,40 @@ appendConstraint :: Rewrite appendConstraint constraintT = go where - go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite l $ \df -> do +#if !MIN_VERSION_ghc(9,2,0) + go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do +#else + go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do +#endif constraint <- liftParseAST df constraintT +#if !MIN_VERSION_ghc(9,2,0) setEntryDPT constraint (DP (0, 1)) -- Paren annotations are usually attached to the first and last constraints, -- rather than to the constraint list itself, so to preserve them we need to reposition them closeParenDP <- lookupAnn (G AnnCloseP) `mapM` lastMaybe ctxt openParenDP <- lookupAnn (G AnnOpenP) `mapM` headMaybe ctxt - ctxt' <- fixParens (join openParenDP) (join closeParenDP) (L l' ctxt) - +#endif + ctxt' <- fixParens +#if !MIN_VERSION_ghc(9,2,0) + (join openParenDP) (join closeParenDP) +#endif + (L l' ctxt) + +#if !MIN_VERSION_ghc(9,2,0) addTrailingCommaT (last ctxt') - return $ L l $ it{hst_ctxt = L l' $ ctxt' ++ [constraint]} +#else + return $ L l $ it{hst_ctxt = Just $ L l' $ ctxt' ++ [constraint]} +#endif go (L _ HsForAllTy{hst_body}) = go hst_body go (L _ (HsParTy _ ty)) = go ty - go (L l other) = Rewrite l $ \df -> do + go (L l other) = Rewrite (locA l) $ \df -> do -- there isn't a context, so we must create one constraint <- liftParseAST df constraintT lContext <- uniqueSrcSpanT lTop <- uniqueSrcSpanT +#if !MIN_VERSION_ghc(9,2,0) let context = L lContext [constraint] addSimpleAnnT context (DP (0, 0)) $ (G AnnDarrow, DP (0, 1)) : @@ -171,14 +249,31 @@ appendConstraint constraintT = go ] | hsTypeNeedsParens sigPrec $ unLoc constraint ] - return $ L lTop $ HsQualTy noExtField context (L l other) - -liftParseAST :: forall ast l. ASTElement l ast => DynFlags -> String -> TransformT (Either String) (Located ast) +#else + let context = Just $ reLocA $ L lContext [constraint] +#endif + + return $ reLocA $ L lTop $ HsQualTy noExtField context (L l other) + +liftParseAST :: forall ast l. (ASTElement l ast + ) + => DynFlags -> String +#if MIN_VERSION_ghc(9,2,0) + -> TransformT (Either String) (GenLocated (SrcAnn l) ast) +#else + -> TransformT (Either String) (Located ast) +#endif liftParseAST df s = case parseAST df "" s of +#if !MIN_VERSION_ghc(9,2,0) Right (anns, x) -> modifyAnnsT (anns <>) $> x +#else + Right x -> pure x +#endif Left _ -> lift $ Left $ "No parse: " <> s -lookupAnn :: (Data a, Monad m) => KeywordId -> Located a -> TransformT m (Maybe DeltaPos) +#if !MIN_VERSION_ghc(9,2,0) +lookupAnn :: (Data a, Monad m) + => KeywordId -> Located a -> TransformT m (Maybe DeltaPos) lookupAnn comment la = do anns <- getAnnsT return $ Map.lookup (mkAnnKey la) anns >>= lookup comment . annsDP @@ -186,6 +281,17 @@ lookupAnn comment la = do dp00 :: DeltaPos dp00 = DP (0, 0) +-- | Copy anns attached to a into b with modification, then delete anns of a +transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) () +transferAnn la lb f = do + anns <- getAnnsT + let oldKey = mkAnnKey la + newKey = mkAnnKey lb + oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns + putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns + +#endif + headMaybe :: [a] -> Maybe a headMaybe [] = Nothing headMaybe (a : _) = Just a @@ -198,19 +304,10 @@ liftMaybe :: String -> Maybe a -> TransformT (Either String) a liftMaybe _ (Just x) = return x liftMaybe s _ = lift $ Left s --- | Copy anns attached to a into b with modification, then delete anns of a -transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) () -transferAnn la lb f = do - anns <- getAnnsT - let oldKey = mkAnnKey la - newKey = mkAnnKey lb - oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns - putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns - ------------------------------------------------------------------------------ extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite extendImport mparent identifier lDecl@(L l _) = - Rewrite l $ \df -> do + Rewrite (locA l) $ \df -> do case mparent of Just parent -> extendImportViaParent df parent identifier lDecl _ -> extendImportTopLevel identifier lDecl @@ -232,7 +329,7 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) , hasSibling <- not $ null lies = do src <- uniqueSrcSpanT top <- uniqueSrcSpanT - let rdr = L src $ mkRdrUnqual $ mkVarOcc thing + let rdr = reLocA $ L src $ mkRdrUnqual $ mkVarOcc thing let alreadyImported = showNameWithoutUniques (occName (unLoc rdr)) @@ -240,11 +337,12 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) when alreadyImported $ lift (Left $ thing <> " already imported") - let lie = L src $ IEName rdr - x = L top $ IEVar noExtField lie + let lie = reLocA $ L src $ IEName rdr + x = reLocA $ L top $ IEVar noExtField lie if x `elem` lies then lift (Left $ thing <> " already imported") else do +#if !MIN_VERSION_ghc(9,2,0) when hasSibling $ addTrailingCommaT (last lies) addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) [] @@ -253,6 +351,7 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) -- we need change the ann key from `[]` to `:` to keep parens and other anns. unless hasSibling $ transferAnn (L l' lies) (L l' [x]) id +#endif return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])} extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list" @@ -277,27 +376,34 @@ extendImportViaParent :: extendImportViaParent df parent child (L l it@ImportDecl{..}) | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies where - go :: Bool -> SrcSpan -> [LIE GhcPs] -> [LIE GhcPs] -> TransformT (Either String) (LImportDecl GhcPs) go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie))) : _xs) | parent == unIEWrappedName ie = lift . Left $ child <> " already included in " <> parent <> " imports" go hide l' pre (lAbs@(L ll' (IEThingAbs _ absIE@(L _ ie))) : xs) -- ThingAbs ie => ThingWith ie child | parent == unIEWrappedName ie = do srcChild <- uniqueSrcSpanT - let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child - childLIE = L srcChild $ IEName childRdr + let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child + childLIE = reLocA $ L srcChild $ IEName childRdr +#if !MIN_VERSION_ghc(9,2,0) x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] [] -- take anns from ThingAbs, and attatch parens to it transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]} addSimpleAnnT childRdr dp00 [(G AnnVal, dp00)] +#else + x :: LIE GhcPs = L ll' $ IEThingWith mempty absIE NoIEWildcard [childLIE] +#endif return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} +#if !MIN_VERSION_ghc(9,2,0) go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs) +#else + go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies')) : xs) +#endif -- ThingWith ie lies' => ThingWith ie (lies' ++ [child]) | parent == unIEWrappedName ie , hasSibling <- not $ null lies' = do srcChild <- uniqueSrcSpanT - let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child + let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child let alreadyImported = showNameWithoutUniques (occName (unLoc childRdr)) @@ -305,11 +411,15 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) when alreadyImported $ lift (Left $ child <> " already included in " <> parent <> " imports") + let childLIE = reLocA $ L srcChild $ IEName childRdr +#if !MIN_VERSION_ghc(9,2,0) when hasSibling $ addTrailingCommaT (last lies') - let childLIE = L srcChild $ IEName childRdr addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)] return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)} +#else + return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith mempty twIE NoIEWildcard (lies' ++ [childLIE]))] ++ xs)} +#endif go hide l' pre (x : xs) = go hide l' (x : pre) xs go hide l' pre [] | hasSibling <- not $ null pre = do @@ -318,13 +428,19 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) srcParent <- uniqueSrcSpanT srcChild <- uniqueSrcSpanT parentRdr <- liftParseAST df parent - let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child + let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child isParentOperator = hasParen parent +#if !MIN_VERSION_ghc(9,2,0) when hasSibling $ addTrailingCommaT (head pre) - let parentLIE = L srcParent $ (if isParentOperator then IEType else IEName) parentRdr - childLIE = L srcChild $ IEName childRdr - x :: LIE GhcPs = L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] [] + let parentLIE = L srcParent $ (if isParentOperator then IEType parentRdr else IEName parentRdr) + childLIE = reLocA $ L srcChild $ IEName childRdr +#else + let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType mempty parentRdr else IEName parentRdr) + childLIE = reLocA $ L srcChild $ IEName childRdr +#endif +#if !MIN_VERSION_ghc(9,2,0) + x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] [] -- Add AnnType for the parent if it's parenthesized (type operator) when isParentOperator $ addSimpleAnnT parentLIE (DP (0, 0)) [(G AnnType, DP (0, 0))] @@ -335,6 +451,9 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) -- we need change the ann key from `[]` to `:` to keep parens and other anns. unless hasSibling $ transferAnn (L l' $ reverse pre) (L l' [x]) id +#else + x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith mempty parentLIE NoIEWildcard [childLIE] +#endif return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x])} extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent" @@ -345,6 +464,7 @@ hasParen :: String -> Bool hasParen ('(' : _) = True hasParen _ = False +#if !MIN_VERSION_ghc(9,2,0) unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)] unqalDP c paren = ( if paren @@ -352,6 +472,7 @@ unqalDP c paren = else pure ) (G AnnVal, dp00) +#endif ------------------------------------------------------------------------------ @@ -360,29 +481,38 @@ hideSymbol :: String -> LImportDecl GhcPs -> Rewrite hideSymbol symbol lidecl@(L loc ImportDecl{..}) = case ideclHiding of - Nothing -> Rewrite loc $ extendHiding symbol lidecl Nothing - Just (True, hides) -> Rewrite loc $ extendHiding symbol lidecl (Just hides) - Just (False, imports) -> Rewrite loc $ deleteFromImport symbol lidecl imports + Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing + Just (True, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) + Just (False, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports hideSymbol _ (L _ (XImportDecl _)) = error "cannot happen" extendHiding :: String -> LImportDecl GhcPs -> +#if !MIN_VERSION_ghc(9,2,0) Maybe (Located [LIE GhcPs]) -> +#else + Maybe (XRec GhcPs [LIE GhcPs]) -> +#endif DynFlags -> TransformT (Either String) (LImportDecl GhcPs) extendHiding symbol (L l idecls) mlies df = do L l' lies <- case mlies of +#if !MIN_VERSION_ghc(9,2,0) Nothing -> flip L [] <$> uniqueSrcSpanT +#else + Nothing -> flip L [] . noAnnSrcSpanDP0 <$> uniqueSrcSpanT +#endif Just pr -> pure pr let hasSibling = not $ null lies src <- uniqueSrcSpanT top <- uniqueSrcSpanT rdr <- liftParseAST df symbol - let lie = L src $ IEName rdr - x = L top $ IEVar noExtField lie + let lie = reLocA $ L src $ IEName rdr + x = reLocA $ L top $ IEVar noExtField lie singleHide = L l' [x] +#if !MIN_VERSION_ghc(9,2,0) when (isNothing mlies) $ do addSimpleAnnT singleHide @@ -401,6 +531,7 @@ extendHiding symbol (L l idecls) mlies df = do addTrailingCommaT (head lies) -- Why we need this? else forM_ mlies $ \lies0 -> do transferAnn lies0 singleHide id +#endif return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)} where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc @@ -408,7 +539,11 @@ extendHiding symbol (L l idecls) mlies df = do deleteFromImport :: String -> LImportDecl GhcPs -> +#if !MIN_VERSION_ghc(9,2,0) Located [LIE GhcPs] -> +#else + XRec GhcPs [LIE GhcPs] -> +#endif DynFlags -> TransformT (Either String) (LImportDecl GhcPs) deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do @@ -418,6 +553,7 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do idecl { ideclHiding = Just (False, edited) } +#if !MIN_VERSION_ghc(9,2,0) -- avoid import A (foo,) whenJust (lastMaybe deletedLies) removeTrailingCommaT when (not (null lies) && null deletedLies) $ do @@ -428,6 +564,7 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do [ (G AnnOpenP, DP (0, 1)) , (G AnnCloseP, DP (0, 0)) ] +#endif pure lidecl' where deletedLies = @@ -439,7 +576,11 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do killLie v@(L _ (IEThingAbs _ (L _ (unqualIEWrapName -> nam)))) | nam == symbol = Nothing | otherwise = Just v +#if !MIN_VERSION_ghc(9,2,0) killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons flds)) +#else + killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons)) +#endif | nam == symbol = Nothing | otherwise = Just $ @@ -449,5 +590,7 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do ty wild (filter ((/= symbol) . unqualIEWrapName . unLoc) cons) +#if !MIN_VERSION_ghc(9,2,0) (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds) +#endif killLie v = Just v From b2881bb5096dd22aea1f64c084f3ab14911c47f1 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 21 Dec 2021 17:30:38 +0530 Subject: [PATCH 022/149] 9.2 compat for Outline --- .../src/Development/IDE/GHC/Compat/Parser.hs | 1 + ghcide/src/Development/IDE/LSP/Outline.hs | 43 +++++++++++-------- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 696647b96b..f7716f861d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -26,6 +26,7 @@ module Development.IDE.GHC.Compat.Parser ( Development.IDE.GHC.Compat.Parser.hpm_src_files, Development.IDE.GHC.Compat.Parser.hpm_annotations, pattern ParsedModule, + Development.IDE.GHC.Compat.Parser.pm_parsed_source, type GHC.ParsedModule, Development.IDE.GHC.Compat.Parser.pm_mod_summary, Development.IDE.GHC.Compat.Parser.pm_extra_src_files, diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 82bdc573cd..586643a4f4 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -18,6 +18,7 @@ import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat (ParsedModule(..)) import Development.IDE.GHC.Error (rangeToRealSrcSpan, realSrcSpanToRange) import Development.IDE.Types.Location @@ -42,7 +43,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif -> let declSymbols = mapMaybe documentSymbolForDecl hsmodDecls moduleSymbol = hsmodName >>= \case - (L (RealSrcSpan l _) m) -> Just $ + (L (locA -> (RealSrcSpan l _)) m) -> Just $ (defDocumentSymbol l :: DocumentSymbol) { _name = pprText m , _kind = SkFile @@ -70,8 +71,8 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif Nothing -> pure $ Right $ InL (List []) -documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol -documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } })) +documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n <> (case pprText fdTyVars of @@ -81,7 +82,7 @@ documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ FamDecl { tcdFam = FamilyDec , _detail = Just $ pprText fdInfo , _kind = SkFunction } -documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars })) +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName name <> (case pprText tcdTyVars of @@ -97,11 +98,11 @@ documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ ClassDecl { tcdLName = L _ n , _kind = SkMethod , _selectionRange = realSrcSpanToRange l' } - | L (RealSrcSpan l _) (ClassOpSig _ False names _) <- tcdSigs - , L (RealSrcSpan l' _) n <- names + | L (locA -> (RealSrcSpan l _)) (ClassOpSig _ False names _) <- tcdSigs + , L (locA -> (RealSrcSpan l' _)) n <- names ] } -documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } })) +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName name , _kind = SkStruct @@ -113,8 +114,8 @@ documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ DataDecl { tcdLName = L _ na , _selectionRange = realSrcSpanToRange l' , _children = conArgRecordFields (con_args x) } - | L (RealSrcSpan l _ ) x <- dd_cons - , L (RealSrcSpan l' _) n <- getConNames' x + | L (locA -> (RealSrcSpan l _ )) x <- dd_cons + , L (locA -> (RealSrcSpan l' _)) n <- getConNames' x ] } where @@ -125,18 +126,19 @@ documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ DataDecl { tcdLName = L _ na , _kind = SkField } | L _ cdf <- lcdfs - , L (RealSrcSpan l _) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf + , L (locA -> (RealSrcSpan l _)) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf ] conArgRecordFields _ = Nothing -documentSymbolForDecl (L (RealSrcSpan l _) (TyClD _ SynDecl { tcdLName = L (RealSrcSpan l' _) n })) = Just +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ SynDecl { tcdLName = L (locA -> (RealSrcSpan l' _)) n })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n , _kind = SkTypeParameter , _selectionRange = realSrcSpanToRange l' } -documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } })) +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty , _kind = SkInterface } +#if !MIN_VERSION_ghc(9,2,0) documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords @@ -149,24 +151,25 @@ documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyF (map pprText feqn_pats) , _kind = SkInterface } -documentSymbolForDecl (L (RealSrcSpan l _) (DerivD _ DerivDecl { deriv_type })) = +#endif +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (DerivD _ DerivDecl { deriv_type })) = gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) -> (defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs) name , _kind = SkInterface } -documentSymbolForDecl (L (RealSrcSpan l _) (ValD _ FunBind{fun_id = L _ name})) = Just +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ FunBind{fun_id = L _ name})) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName name , _kind = SkFunction } -documentSymbolForDecl (L (RealSrcSpan l _) (ValD _ PatBind{pat_lhs})) = Just +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ PatBind{pat_lhs})) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText pat_lhs , _kind = SkFunction } -documentSymbolForDecl (L (RealSrcSpan l _) (ForD _ x)) = Just +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ForD _ x)) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = case x of ForeignImport{} -> name @@ -199,8 +202,8 @@ documentSymbolForImportSummary importSymbols = , _children = Just (List importSymbols) } -documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol -documentSymbolForImport (L (RealSrcSpan l _) ImportDecl { ideclName, ideclQualified }) = Just +documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol +documentSymbolForImport (L (locA -> (RealSrcSpan l _)) ImportDecl { ideclName, ideclQualified }) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = "import " <> pprText ideclName , _kind = SkModule @@ -230,7 +233,11 @@ pprText :: Outputable a => a -> Text pprText = pack . showSDocUnsafe . ppr -- the version of getConNames for ghc9 is restricted to only the renaming phase +#if !MIN_VERSION_ghc(9,2,0) getConNames' :: ConDecl GhcPs -> [Located (IdP GhcPs)] +#else +getConNames' :: ConDecl GhcPs -> [XRec GhcPs (IdP GhcPs)] +#endif getConNames' ConDeclH98 {con_name = name} = [name] getConNames' ConDeclGADT {con_names = names} = names #if !MIN_VERSION_ghc(8,10,0) From c06978b3cb4bb1b59fa82add8a2e822ed5ee5e9d Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 21 Dec 2021 17:36:14 +0530 Subject: [PATCH 023/149] 9.2 compat for Pragmas plugin --- ghcide/src/Development/IDE/Spans/Pragmas.hs | 34 ++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 132e1e460b..b07d731aba 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -122,13 +122,21 @@ updateParserState token range prevParserState ModeInitial -> case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } +#if !MIN_VERSION_ghc(9,2,0) ITlineComment s +#else + ITlineComment s _ +#endif | isDownwardLineHaddock s -> defaultParserState{ mode = ModeHaddock } | otherwise -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing , mode = ModeComment } +#if !MIN_VERSION_ghc(9,2,0) ITblockComment s +#else + ITblockComment s _ +#endif | isPragma s -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing @@ -144,7 +152,11 @@ updateParserState token range prevParserState ModeComment -> case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } +#if !MIN_VERSION_ghc(9,2,0) ITlineComment s +#else + ITlineComment s _ +#endif | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } @@ -156,7 +168,11 @@ updateParserState token range prevParserState , mode = ModeHaddock } | otherwise -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing } +#if !MIN_VERSION_ghc(9,2,0) ITblockComment s +#else + ITblockComment s _ +#endif | isPragma s -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing @@ -180,13 +196,21 @@ updateParserState token range prevParserState case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } +#if !MIN_VERSION_ghc(9,2,0) ITlineComment s +#else + ITlineComment s _ +#endif | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } | otherwise -> defaultParserState +#if !MIN_VERSION_ghc(9,2,0) ITblockComment s +#else + ITblockComment s _ +#endif | isPragma s -> defaultParserState{ nextPragma = NextPragmaInfo (endLine + 1) Nothing, @@ -200,7 +224,11 @@ updateParserState token range prevParserState ModePragma -> case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } +#if !MIN_VERSION_ghc(9,2,0) ITlineComment s +#else + ITlineComment s _ +#endif | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } @@ -210,7 +238,11 @@ updateParserState token range prevParserState defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } | otherwise -> defaultParserState +#if !MIN_VERSION_ghc(9,2,0) ITblockComment s +#else + ITblockComment s _ +#endif | isPragma s -> defaultParserState{ nextPragma = NextPragmaInfo (endLine + 1) Nothing, lastPragmaLine = endLine } | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits @@ -390,7 +422,7 @@ mkLexerPState dynFlags stringBuffer = <*> const False finalPState = mkPStatePure (mkLexerParserFlags finalDynFlags) stringBuffer startRealSrcLoc #else - pState = mkPState finalDynFlags stringBuffer startRealSrcLoc + pState = initParserState (initParserOpts finalDynFlags) stringBuffer startRealSrcLoc PState{ options = pStateOptions } = pState finalExtBitsMap = setBit (pExtsBitmap pStateOptions) (fromEnum UsePosPragsBit) finalPStateOptions = pStateOptions{ pExtsBitmap = finalExtBitsMap } From 6782d557b5cc35591250ace6deb7d6fb327d70ae Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 21 Dec 2021 18:53:11 +0530 Subject: [PATCH 024/149] Get the rest compiling with 9.2 --- .../src/Development/IDE/Plugin/CodeAction.hs | 151 +++++++++++------- .../Development/IDE/Plugin/CodeAction/Args.hs | 18 +++ .../src/Development/IDE/Plugin/Completions.hs | 19 ++- .../IDE/Plugin/Completions/Logic.hs | 41 ++--- .../src/Development/IDE/Plugin/TypeLenses.hs | 4 +- 5 files changed, 151 insertions(+), 82 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 6a7a636e55..034137b629 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -2,6 +2,8 @@ -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DuplicateRecordFields #-} -- | Go to the definition of a variable. @@ -78,6 +80,7 @@ import Language.LSP.VFS import Text.Regex.TDFA (mrAfter, (=~), (=~~)) +import GHC.Types.Avail (greNameMangledName) ------------------------------------------------------------------------------------------------- -- | Generate code actions. @@ -140,7 +143,7 @@ fillHolePluginDescriptor = mkGhcideCAPlugin $ wrap suggestFillHole ------------------------------------------------------------------------------------------------- -findSigOfDecl :: (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p) +findSigOfDecl :: p ~ GhcPass p0 => (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p) findSigOfDecl pred decls = listToMaybe [ sig @@ -148,7 +151,7 @@ findSigOfDecl pred decls = any (pred . unLoc) idsSig ] -findSigOfDeclRanged :: Range -> [LHsDecl p] -> Maybe (Sig p) +findSigOfDeclRanged :: p ~ GhcPass p0 => Range -> [LHsDecl p] -> Maybe (Sig p) findSigOfDeclRanged range decls = do dec <- findDeclContainingLoc (_start range) decls case dec of @@ -156,7 +159,7 @@ findSigOfDeclRanged range decls = do L _ (ValD _ (bind :: HsBind p)) -> findSigOfBind range bind _ -> Nothing -findSigOfBind :: Range -> HsBind p -> Maybe (Sig p) +findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p) findSigOfBind range bind = case bind of FunBind {} -> findSigOfLMatch (unLoc $ mg_alts (fun_matches bind)) @@ -165,14 +168,18 @@ findSigOfBind range bind = findSigOfLMatch :: [LMatch p (LHsExpr p)] -> Maybe (Sig p) findSigOfLMatch ls = do match <- findDeclContainingLoc (_start range) ls - findSigOfGRHSs (m_grhss (unLoc match)) + findSigOfGRHSs (getLoc $ reLoc match) (m_grhss (unLoc match)) - findSigOfGRHSs :: GRHSs p (LHsExpr p) -> Maybe (Sig p) - findSigOfGRHSs grhs = do - if _start range `isInsideSrcSpan` (getLoc $ grhssLocalBinds grhs) + findSigOfGRHSs :: SrcSpan -> GRHSs p (LHsExpr p) -> Maybe (Sig p) + findSigOfGRHSs span grhs = do + if _start range `isInsideSrcSpan` span +#if !MIN_VERSION_ghc(9,2,0) then findSigOfBinds range (unLoc (grhssLocalBinds grhs)) -- where clause +#else + then findSigOfBinds range (grhssLocalBinds grhs) -- where clause +#endif else do - grhs <- findDeclContainingLoc (_start range) (grhssGRHSs grhs) + grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs) case unLoc grhs of GRHS _ _ bd -> findSigOfExpr (unLoc bd) _ -> Nothing @@ -180,15 +187,15 @@ findSigOfBind range bind = findSigOfExpr :: HsExpr p -> Maybe (Sig p) findSigOfExpr = go where - go (HsLet _ binds _) = findSigOfBinds range (unLoc binds) + go (HsLet _ binds _) = findSigOfBinds range binds go (HsDo _ _ stmts) = do stmtlr <- unLoc <$> findDeclContainingLoc (_start range) (unLoc stmts) case stmtlr of - LetStmt _ lhsLocalBindsLR -> findSigOfBinds range $ unLoc lhsLocalBindsLR + LetStmt _ lhsLocalBindsLR -> findSigOfBinds range $ lhsLocalBindsLR _ -> Nothing go _ = Nothing -findSigOfBinds :: Range -> HsLocalBinds p -> Maybe (Sig p) +findSigOfBinds :: p ~ GhcPass p0 => Range -> HsLocalBinds p -> Maybe (Sig p) findSigOfBinds range = go where go (HsValBinds _ (ValBinds _ binds lsigs)) = @@ -199,16 +206,19 @@ findSigOfBinds range = go findSigOfBind range (unLoc lHsBindLR) go _ = Nothing -findInstanceHead :: (Outputable (HsType p)) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p) +findInstanceHead :: (Outputable (HsType p), p ~ GhcPass p0) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p) findInstanceHead df instanceHead decls = listToMaybe [ hsib_body +#if !MIN_VERSION_ghc(9,2,0) | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB {hsib_body}})) <- decls, +#else + | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig {sig_body = hsib_body})})) <- decls, +#endif showSDoc df (ppr hsib_body) == instanceHead ] -findDeclContainingLoc :: Position -> [Located a] -> Maybe (Located a) -findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` l) +findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- Single: @@ -280,9 +290,9 @@ isUnusedImportedId imv_name == mkModuleName modName, isTheSameLine imv_span importSpan ], - [GRE {..}] <- lookupGlobalRdrEnv rdrEnv occ, - importedIdentifier <- Right gre_name, - refs <- M.lookup importedIdentifier refMap = + [GRE {gre_name = name}] <- lookupGlobalRdrEnv rdrEnv occ, + importedIdentifier <- Right name, + refs <- M.lookup (fmap greNameMangledName importedIdentifier) refMap = maybe True (not . any (\(_, IdentifierDetails {..}) -> identInfo == S.singleton Use)) refs | otherwise = False @@ -290,7 +300,7 @@ suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [( suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmodImports}} contents Diagnostic{_range=_range,..} -- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant | Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant" - , Just (L _ impDecl) <- find (\(L l _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports + , Just (L _ impDecl) <- find (\(L (locA -> l) _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports , Just c <- contents , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings) , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T.unpack c) (concat ranges) @@ -390,7 +400,7 @@ suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T.Text, [Ra suggestRemoveRedundantExport ParsedModule{pm_parsed_source = L _ HsModule{..}} Diagnostic{..} | msg <- unifySpaces _message , Just export <- hsmodExports - , Just exportRange <- getLocatedRange export + , Just exportRange <- getLocatedRange $ reLoc export , exports <- unLoc export , Just (removeFromExport, !ranges) <- fmap (getRanges exports . notInScope) (extractNotInScopeName msg) <|> (,[_range]) <$> matchExportItem msg @@ -418,7 +428,7 @@ suggestDeleteUnusedBinding | otherwise = [] where relatedRanges indexedContent name = - concatMap (findRelatedSpans indexedContent name) hsmodDecls + concatMap (findRelatedSpans indexedContent name) $ map reLoc hsmodDecls toRange = realSrcSpanToRange extendForSpaces = extendToIncludePreviousNewlineIfPossible @@ -433,7 +443,7 @@ suggestDeleteUnusedBinding findSig _ = [] in extendForSpaces indexedContent (toRange l) : - concatMap findSig hsmodDecls + concatMap findSig (map reLoc hsmodDecls) _ -> concatMap (findRelatedSpanForMatch indexedContent name) matches findRelatedSpans _ _ _ = [] @@ -444,7 +454,7 @@ suggestDeleteUnusedBinding FunBind { fun_id=lname , fun_matches=MG {mg_alts=L _ matches} - } = Just (lname, matches) + } = Just (reLoc lname, matches) extractNameAndMatchesFromFunBind _ = Nothing findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range] @@ -461,16 +471,16 @@ suggestDeleteUnusedBinding let maybeIdx = findIndex (\(L _ id) -> isSameName id name) lnames in case maybeIdx of Nothing -> Nothing - Just _ | length lnames == 1 -> Just (getLoc $ head lnames, True) + Just _ | length lnames == 1 -> Just (getLoc $ reLoc $ head lnames, True) Just idx -> - let targetLname = getLoc $ lnames !! idx + let targetLname = getLoc $ reLoc $ lnames !! idx startLoc = srcSpanStart targetLname endLoc = srcSpanEnd targetLname startLoc' = if idx == 0 then startLoc - else srcSpanEnd . getLoc $ lnames !! (idx - 1) + else srcSpanEnd . getLoc . reLoc $ lnames !! (idx - 1) endLoc' = if idx == 0 && idx < length lnames - 1 - then srcSpanStart . getLoc $ lnames !! (idx + 1) + then srcSpanStart . getLoc . reLoc $ lnames !! (idx + 1) else endLoc in Just (mkSrcSpan startLoc' endLoc', False) findRelatedSigSpan1 _ _ = Nothing @@ -486,7 +496,11 @@ suggestDeleteUnusedBinding name (L _ Match{m_grhss=GRHSs{grhssLocalBinds}}) = do case grhssLocalBinds of +#if !MIN_VERSION_ghc(9,2,0) (L _ (HsValBinds _ (ValBinds _ bag lsigs))) -> +#else + (HsValBinds _ (ValBinds _ bag lsigs)) -> +#endif if isEmptyBag bag then [] else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag @@ -503,12 +517,12 @@ suggestDeleteUnusedBinding indexedContent name lsigs - (L (RealSrcSpan l _) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) = + (L (locA -> (RealSrcSpan l _)) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) = if isTheBinding (getLoc lname) then let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig findSig _ = [] - in extendForSpaces indexedContent (toRange l) : concatMap findSig lsigs + in extendForSpaces indexedContent (toRange l) : concatMap findSig (map reLoc lsigs) else concatMap (findRelatedSpanForMatch indexedContent name) matches findRelatedSpanForHsBind _ _ _ _ = [] @@ -535,11 +549,11 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul <|> matchRegexUnifySpaces _message ".*Defined but not used: data constructor ‘([^ ]+)’" , Just (exportType, _) <- find (matchWithDiagnostic _range . snd) . mapMaybe - (\(L l b) -> if maybe False isTopLevel $ srcSpanToRange l + (\(L (locA -> l) b) -> if maybe False isTopLevel $ srcSpanToRange l then exportsAs b else Nothing) $ hsmodDecls - , Just pos <- fmap _end . getLocatedRange =<< hsmodExports - , Just needComma <- needsComma source <$> hsmodExports + , Just pos <- fmap _end . getLocatedRange =<< fmap reLoc hsmodExports + , Just needComma <- needsComma source <$> fmap reLoc hsmodExports , let exportName = (if needComma then "," else "") <> printExport exportType name insertPos = pos {_character = pred $ _character pos} = [("Export ‘" <> name <> "’", TextEdit (Range insertPos insertPos) exportName)] @@ -550,7 +564,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul needsComma _ (L _ []) = False needsComma source (L (RealSrcSpan l _) exports) = let closeParan = _end $ realSrcSpanToRange l - lastExport = fmap _end . getLocatedRange $ last exports + lastExport = fmap _end . getLocatedRange $ last $ fmap reLoc exports in case lastExport of Just lastExport -> not $ T.isInfixOf "," $ textInRange (Range lastExport closeParan) source _ -> False @@ -577,13 +591,13 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul isTopLevel :: Range -> Bool isTopLevel l = (_character . _start) l == 0 - exportsAs :: HsDecl p -> Maybe (ExportsAs, Located (IdP p)) - exportsAs (ValD _ FunBind {fun_id}) = Just (ExportName, fun_id) - exportsAs (ValD _ (PatSynBind _ PSB {psb_id})) = Just (ExportPattern, psb_id) - exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, tcdLName) - exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, tcdLName) - exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, tcdLName) - exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportAll, fdLName tcdFam) + exportsAs :: HsDecl GhcPs -> Maybe (ExportsAs, Located (IdP GhcPs)) + exportsAs (ValD _ FunBind {fun_id}) = Just (ExportName, reLoc fun_id) + exportsAs (ValD _ (PatSynBind _ PSB {psb_id})) = Just (ExportPattern, reLoc psb_id) + exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, reLoc tcdLName) + exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, reLoc $ tcdLName) + exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, reLoc $ tcdLName) + exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportAll, reLoc $ fdLName tcdFam) exportsAs _ = Nothing suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] @@ -676,7 +690,7 @@ newDefinitionAction :: IdeOptions -> ParsedModule -> Range -> T.Text -> T.Text - newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ | Range _ lastLineP : _ <- [ realSrcSpanToRange sp - | (L l@(RealSrcSpan sp _) _) <- hsmodDecls + | (L (locA -> l@(RealSrcSpan sp _)) _) <- hsmodDecls , _start `isInsideSrcSpan` l] , nextLineP <- Position{ _line = _line lastLineP + 1, _character = 0} = [ ("Define " <> sig @@ -848,12 +862,12 @@ data HidingMode Bool -- ^ Parenthesised? ModuleName - deriving (Show) + -- deriving (Show) data ModuleTarget = ExistingImp (NonEmpty (LImportDecl GhcPs)) | ImplicitPrelude [LImportDecl GhcPs] - deriving (Show) + -- deriving (Show) targetImports :: ModuleTarget -> [LImportDecl GhcPs] targetImports (ExistingImp ne) = NE.toList ne @@ -1006,13 +1020,13 @@ disambiguateSymbol pm fileContents Diagnostic {..} (T.unpack -> symbol) = \case liftParseAST @(HsExpr GhcPs) df $ prettyPrint $ HsVar @GhcPs noExtField $ - L (mkGeneralSrcSpan "") rdr + reLocA $ L (mkGeneralSrcSpan "") rdr else Rewrite (rangeToSrcSpan "" _range) $ \df -> liftParseAST @RdrName df $ prettyPrint $ L (mkGeneralSrcSpan "") rdr ] findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs) -findImportDeclByRange xs range = find (\(L l _)-> srcSpanToRange l == Just range) xs +findImportDeclByRange xs range = find (\(L (locA -> l) _)-> srcSpanToRange l == Just range) xs suggestFixConstructorImport :: Diagnostic -> [(T.Text, TextEdit)] suggestFixConstructorImport Diagnostic{_range=_range,..} @@ -1074,7 +1088,11 @@ suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing -- (Pair x x') == (Pair y y') = x == y && x' == y' | Just [instanceLineStr, constraintFirstCharStr] <- matchRegexUnifySpaces _message "bound by the instance declaration at .+:([0-9]+):([0-9]+)" +#if !MIN_VERSION_ghc(9,2,0) , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB{hsib_body}}))) +#else + , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig{sig_body = hsib_body})}))) +#endif <- findDeclContainingLoc (Position (readPositionNumber instanceLineStr) (readPositionNumber constraintFirstCharStr)) hsmodDecls = Just hsib_body | otherwise @@ -1094,7 +1112,12 @@ suggestImplicitParameter :: suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _range} | Just [implicitT] <- matchRegexUnifySpaces _message "Unbound implicit parameter \\(([^:]+::.+)\\) arising", Just (L _ (ValD _ FunBind {fun_id = L _ funId})) <- findDeclContainingLoc (_start _range) hsmodDecls, - Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}}) <- findSigOfDecl (== funId) hsmodDecls +#if !MIN_VERSION_ghc(9,2,0) + Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}}) +#else + Just (TypeSig _ _ HsWC {hswc_body = (unLoc -> HsSig {sig_body = hsib_body})}) +#endif + <- findSigOfDecl (== funId) hsmodDecls = [( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId) , appendConstraint (T.unpack implicitT) hsib_body)] @@ -1129,7 +1152,11 @@ suggestFunctionConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing -- In an equation for ‘eq’: -- eq (Pair x y) (Pair x' y') = x == x' && y == y' | Just typeSignatureName <- findTypeSignatureName _message +#if !MIN_VERSION_ghc(9,2,0) , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}}) +#else + , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})}) +#endif <- findSigOfDecl ((T.unpack typeSignatureName ==) . showSDoc df . ppr) hsmodDecls , title <- actionTitle missingConstraint typeSignatureName = [(title, appendConstraint (T.unpack missingConstraint) sig)] @@ -1152,7 +1179,11 @@ removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..} -- Account for both "Redundant constraint" and "Redundant constraints". | "Redundant constraint" `T.isInfixOf` _message , Just typeSignatureName <- findTypeSignatureName _message +#if !MIN_VERSION_ghc(9,2,0) , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}}) +#else + , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})}) +#endif <- findSigOfDeclRanged _range hsmodDecls , Just redundantConstraintList <- findRedundantConstraints _message , rewrite <- removeConstraint (toRemove df redundantConstraintList) sig @@ -1291,8 +1322,8 @@ newImportToEdit (unNewImport -> imp) ps fileContents newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange (L _ HsModule {..}) fileContents | Just (uncurry Position -> insertPos, col) <- case hsmodImports of - [] -> findPositionNoImports hsmodName hsmodExports fileContents - _ -> findPositionFromImportsOrModuleDecl hsmodImports last True + [] -> findPositionNoImports (fmap reLoc hsmodName) (fmap reLoc hsmodExports) fileContents + _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last True = Just (Range insertPos insertPos, col) | otherwise = Nothing @@ -1534,22 +1565,34 @@ smallerRangesForBindingExport lies b = where unqualify = snd . breakOnEnd "." b' = wrapOperatorInParens . unqualify $ b +#if !MIN_VERSION_ghc(9,2,0) ranges' (L _ (IEThingWith _ thing _ inners labels)) +#else + ranges' (L _ (IEThingWith _ thing _ inners)) +#endif | showSDocUnsafe (ppr thing) == b' = [] | otherwise = - [ l' | L l' x <- inners, showSDocUnsafe (ppr x) == b'] ++ - [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b'] + [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b'] +#if !MIN_VERSION_ghc(9,2,0) + ++ [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b'] +#endif ranges' _ = [] rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan] -rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l] -rangesForBinding' b (L l x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l] -rangesForBinding' b (L l (IEThingAll _ x)) | showSDocUnsafe (ppr x) == b = [l] +rangesForBinding' b (L (locA -> l) x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l] +rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l] +rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | showSDocUnsafe (ppr x) == b = [l] +#if !MIN_VERSION_ghc(9,2,0) rangesForBinding' b (L l (IEThingWith _ thing _ inners labels)) +#else +rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _ inners)) +#endif | showSDocUnsafe (ppr thing) == b = [l] | otherwise = - [ l' | L l' x <- inners, showSDocUnsafe (ppr x) == b] ++ - [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b] + [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b] +#if !MIN_VERSION_ghc(9,2,0) + ++ [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b] +#endif rangesForBinding' _ _ = [] -- | 'matchRegex' combined with 'unifySpaces' diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index da56246f29..408dd89c44 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} module Development.IDE.Plugin.CodeAction.Args ( CodeActionTitle, @@ -119,7 +120,11 @@ instance ToTextEdit Rewrite where runMaybeT $ do df <- MaybeT caaDf ps <- MaybeT caaAnnSource +#if !MIN_VERSION_ghc(9,2,0) let r = rewriteToEdit df (annsA ps) rw +#else + let r = rewriteToEdit df rw +#endif pure $ fromRight [] r instance ToTextEdit a => ToTextEdit [a] where @@ -140,7 +145,11 @@ data CodeActionArgs = CodeActionArgs caaParsedModule :: IO (Maybe ParsedModule), caaContents :: IO (Maybe T.Text), caaDf :: IO (Maybe DynFlags), +#if !MIN_VERSION_ghc(9,2,0) caaAnnSource :: IO (Maybe (Annotated ParsedSource)), +#else + caaAnnSource :: IO (Maybe ParsedSource), +#endif caaTmr :: IO (Maybe TcModuleResult), caaHar :: IO (Maybe HieAstResult), caaBindings :: IO (Maybe Bindings), @@ -210,7 +219,11 @@ toCodeAction3 get f = ReaderT $ \caa -> get caa >>= flip runReaderT caa . toCode instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} -> x >>= \case +#if !MIN_VERSION_ghc(9,2,0) Just s -> flip runReaderT caa . toCodeAction . f . astA $ s +#else + Just s -> flip runReaderT caa . toCodeAction . f $ s +#endif _ -> pure [] instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where @@ -240,11 +253,16 @@ instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where instance ToCodeAction r => ToCodeAction (DynFlags -> r) where toCodeAction = toCodeAction2 caaDf +#if !MIN_VERSION_ghc(9,2,0) instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where toCodeAction = toCodeAction1 caaAnnSource instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where toCodeAction = toCodeAction2 caaAnnSource +#else +instance ToCodeAction r => ToCodeAction (Maybe ParsedSource -> r) where + toCodeAction = toCodeAction1 caaAnnSource +#endif instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where toCodeAction = toCodeAction1 caaTmr diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index ea8a025197..2a60f62534 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} module Development.IDE.Plugin.Completions ( descriptor @@ -24,7 +25,7 @@ import Development.IDE.Core.Service import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (rangeToSrcSpan) -import Development.IDE.GHC.ExactPrint (Annotated (annsA), +import Development.IDE.GHC.ExactPrint (Annotated(..), GetAnnotatedParsedSource (GetAnnotatedParsedSource), astA) import Development.IDE.GHC.Util (prettyPrint) @@ -89,7 +90,7 @@ produceCompletions = do _ -> return ([], Nothing) -- Drop any explicit imports in ImportDecl if not hidden -dropListFromImportDecl :: GenLocated SrcSpan (ImportDecl GhcPs) -> GenLocated SrcSpan (ImportDecl GhcPs) +dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs dropListFromImportDecl iDecl = let f d@ImportDecl {ideclHiding} = case ideclHiding of Just (False, _) -> d {ideclHiding=Nothing} @@ -244,24 +245,28 @@ extendImportHandler' ideState ExtendImport {..} case existingImport of Just imp -> do fmap (nfp,) $ liftEither $ - rewriteToWEdit df doc (annsA ps) $ - extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp + rewriteToWEdit df doc +#if !MIN_VERSION_ghc(9,2,0) + (annsA ps) +#endif + $ + extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp Nothing -> do let n = newImport importName sym importQual False sym = if isNothing importQual then Just it else Nothing it = case thingParent of Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" - t <- liftMaybe $ snd <$> newImportToEdit n (astA ps) (fromMaybe "" contents) + t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents) return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero -isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool +isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl GhcPs) -> Bool isWantedModule wantedModule Nothing (L _ it@ImportDecl{ideclName, ideclHiding = Just (False, _)}) = not (isQualifiedImport it) && unLoc ideclName == wantedModule isWantedModule wantedModule (Just qual) (L _ ImportDecl{ideclAs, ideclName, ideclHiding = Just (False, _)}) = - unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc <$> ideclAs) == Just qual) + unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc . reLoc <$> ideclAs) == Just qual) isWantedModule _ _ _ = False liftMaybe :: Monad m => Maybe a -> MaybeT m a diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index ebf52a0cc1..d12dbd8e4a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -54,6 +54,7 @@ import Language.LSP.Types.Capabilities import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score_), original) +import GHC.Types.Avail (greNamePrintableName) -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int @@ -79,11 +80,11 @@ data Context = TypeContext -- i.e. where are the value decls and the type decls getCContext :: Position -> ParsedModule -> Maybe Context getCContext pos pm - | Just (L r modName) <- moduleHeader + | Just (L (locA -> r) modName) <- moduleHeader , pos `isInsideSrcSpan` r = Just (ModuleContext (moduleNameString modName)) - | Just (L r _) <- exportList + | Just (L (locA -> r) _) <- exportList , pos `isInsideSrcSpan` r = Just ExportContext @@ -102,23 +103,23 @@ getCContext pos pm imports = hsmodImports $ unLoc $ pm_parsed_source pm go :: LHsDecl GhcPs -> Maybe Context - go (L r SigD {}) + go (L (locA -> r) SigD {}) | pos `isInsideSrcSpan` r = Just TypeContext | otherwise = Nothing - go (L r GHC.ValD {}) + go (L (locA -> r) GHC.ValD {}) | pos `isInsideSrcSpan` r = Just ValueContext | otherwise = Nothing go _ = Nothing goInline :: GHC.LHsType GhcPs -> Maybe Context - goInline (GHC.L r _) + goInline (GHC.L (locA -> r) _) | pos `isInsideSrcSpan` r = Just TypeContext goInline _ = Nothing importGo :: GHC.LImportDecl GhcPs -> Maybe Context - importGo (L r impDecl) + importGo (L (locA -> r) impDecl) | pos `isInsideSrcSpan` r - = importInline importModuleName (ideclHiding impDecl) + = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl) <|> Just (ImportContext importModuleName) | otherwise = Nothing @@ -331,12 +332,12 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do curModName = moduleName curMod curModNameText = ppr curModName - importMap = Map.fromList [ (l, imp) | imp@(L (RealSrcSpan l _) _) <- limports ] + importMap = Map.fromList [ (l, imp) | imp@(L (locA -> (RealSrcSpan l _)) _) <- limports ] - iDeclToModName :: ImportDecl name -> ModuleName + iDeclToModName :: ImportDecl GhcPs -> ModuleName iDeclToModName = unLoc . ideclName - asNamespace :: ImportDecl name -> ModuleName + asNamespace :: ImportDecl GhcPs -> ModuleName asNamespace imp = maybe (iDeclToModName imp) GHC.unLoc (ideclAs imp) -- Full canonical names of imported modules importDeclerations = map unLoc limports @@ -356,8 +357,8 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do getComplsForOne :: GlobalRdrElt -> IO ([CompItem],QualCompls) getComplsForOne (GRE n par True _) = - (, mempty) <$> toCompItem par curMod curModNameText n Nothing - getComplsForOne (GRE n par False prov) = + (, mempty) <$> toCompItem par curMod curModNameText (greNamePrintableName n) Nothing + getComplsForOne (GRE (greNamePrintableName -> n) par False prov) = flip foldMapM (map is_decl prov) $ \spec -> do let originalImportDecl = do -- we don't want to extend import if it's already in scope @@ -382,7 +383,9 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do let (mbParent, originName) = case par of NoParent -> (Nothing, nameOccName n) ParentIs n' -> (Just . T.pack $ printName n', nameOccName n) +#if !MIN_VERSION_ghc(9,2,0) FldParent n' lbl -> (Just . T.pack $ printName n', maybe (nameOccName n) mkVarOccFS lbl) +#endif tys <- catchSrcErrors (hsc_dflags packageState) "completion" $ do name' <- lookupName packageState m n return ( name' >>= safeTyThingType @@ -446,7 +449,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod , id <- ids] TyClD _ x -> let generalCompls = [mkComp id cl (Just $ ppr $ tcdLName x) - | id <- listify (\(_ :: Located(IdP GhcPs)) -> True) x + | id <- listify (\(_ :: LIdP GhcPs) -> True) x , let cl = occNameToComKind Nothing (rdrNameOcc $ unLoc id)] -- here we only have to look at the outermost type recordCompls = findRecordCompl uri pm (Local pos) x @@ -458,7 +461,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod ForD _ ForeignExport{fd_name,fd_sig_ty} -> [mkComp fd_name CiVariable (Just $ ppr fd_sig_ty)] _ -> [] - | L pos decl <- hsmodDecls, + | L (locA -> pos) decl <- hsmodDecls, let mkComp = mkLocalComp pos ] @@ -470,7 +473,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod -- instead of using the empty string here, we should probably introduce a new field... ensureTypeText = Just $ fromMaybe "" ty pn = ppr n - doc = SpanDocText (getDocumentation [pm] n) (SpanDocUris Nothing Nothing) + doc = SpanDocText (getDocumentation [pm] $ reLoc n) (SpanDocUris Nothing Nothing) findRecordCompl :: Uri -> ParsedModule -> Provenance -> TyClDecl GhcPs -> [CompItem] findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result @@ -480,15 +483,15 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result | ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn , Just con_details <- [getFlds con_args] , let field_names = concatMap extract con_details - , let field_labels = showGhc . unLoc <$> field_names + , let field_labels = showGhc <$> field_names , (not . List.null) field_labels ] - doc = SpanDocText (getDocumentation [pmod] tcdLName) (SpanDocUris Nothing Nothing) + doc = SpanDocText (getDocumentation [pmod] $ reLoc tcdLName) (SpanDocUris Nothing Nothing) - getFlds :: HsConDetails arg (Located [LConDeclField GhcPs]) -> Maybe [ConDeclField GhcPs] + getFlds :: HsConDeclH98Details GhcPs -> Maybe [ConDeclField GhcPs] getFlds conArg = case conArg of RecCon rec -> Just $ unLoc <$> unLoc rec - PrefixCon _ -> Just [] + PrefixCon _ _ -> Just [] _ -> Nothing extract ConDeclField{..} diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 115d8ae3b5..b3ec458b55 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -216,7 +216,7 @@ instance A.FromJSON Mode where -------------------------------------------------------------------------------- showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String -showDocRdrEnv env rdrEnv = showSDocForUser (hsc_dflags env) (mkPrintUnqualified (hsc_dflags env) rdrEnv) +showDocRdrEnv env rdrEnv = showSDocForUser (hsc_dflags env) (unitState env) (mkPrintUnqualifiedDefault env rdrEnv) data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs deriving (Generic, Show, Eq, Ord, Hashable, NFData) @@ -253,7 +253,7 @@ gblBindingType :: Maybe HscEnv -> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeS gblBindingType (Just hsc) (Just gblEnv) = do let exports = availsToNameSet $ tcg_exports gblEnv sigs = tcg_sigs gblEnv - binds = collectHsBindsBinders $ tcg_binds gblEnv + binds = collectHsBindsBinders CollNoDictBinders $ tcg_binds gblEnv patSyns = tcg_patsyns gblEnv rdrEnv = tcg_rdr_env gblEnv showDoc = showDocRdrEnv hsc rdrEnv From ba4d618ba50033fc0b0e628344f09b8cd5a80e55 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 16:12:04 +0200 Subject: [PATCH 025/149] WIP: PLEASE, DROP THIS COMMIT BEFORE MERGE This hook starts caching pipeline inside of the PR. If this got merged - all PRs would start to run caching workflow (which is undesirable, because of platform limitations) --- .github/workflows/caching.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index 9d03a01a15..d605e24d3e 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -42,6 +42,10 @@ on: # Reinstitution of the main chache puts it back into FIFO # & so it gets shared across all PRs. - cron: "25 2/8 * * *" + # 2021-12-21: FIXME: Remove this endry before merge. + pull_request: + branches: + - '**' env: cabalBuild: "v2-build all --enable-tests --enable-benchmarks" From 208f4844f44af7368014d7872916473ae31deebd Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 16:13:36 +0200 Subject: [PATCH 026/149] disabling {test,bench} to properly heat-up the cache `index-state` change means nothing, but allow to run increment action on dependency cache pile (as otherwise cache stays idempotent to its key id). --- .github/workflows/bench.yml | 9 +++++---- .github/workflows/test.yml | 9 +++++---- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 5 files changed, 13 insertions(+), 11 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index a79b1a969b..b197613949 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -9,10 +9,11 @@ concurrency: group: ${{ github.head_ref }}-${{ github.workflow }} cancel-in-progress: true -on: - pull_request: - branches: - - '**' +# 2021-12-21: FIXME: Revert this to enable test build, which now would be with hot cache +# on: +# pull_request: +# branches: +# - '**' jobs: pre_job: diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index f1e8551e0b..877c39da0d 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -9,10 +9,11 @@ concurrency: group: ${{ github.head_ref }}-${{ github.workflow }} cancel-in-progress: true -on: - pull_request: - branches: - - '**' +# 2021-12-21: FIXME: Revert this to enable test build, which now would be with hot cache +# on: +# pull_request: +# branches: +# - '**' jobs: pre_job: diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 043afcca75..7e1bb92849 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:08Z +index-state: 2021-11-29T12:30:09Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index eeeeb08e16..50647372e4 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:00Z +index-state: 2021-12-18T00:00:01Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index 7c70a8c62a..0d8a1090d7 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:08Z +index-state: 2021-11-29T12:30:09Z constraints: hyphenation +embed From 7bb7cae5f0dda30faf0ec01430053b18d8eeb5c0 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 16:30:11 +0200 Subject: [PATCH 027/149] CI: index-state: +1s refresh Somehow previous run got early termination. Seems like some GitHub bug, since cache-hit promises to True only on direct key hit (& we had indirect). Maybe second time the charm. --- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 7e1bb92849..c536524a45 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:09Z +index-state: 2021-11-29T12:30:10Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 50647372e4..a33387dece 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:01Z +index-state: 2021-12-18T00:00:02Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index 0d8a1090d7..ffc53d8fae 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:09Z +index-state: 2021-11-29T12:30:10Z constraints: hyphenation +embed From ed99ae7ee044c1d7b27d091b3c5501b3242fbcde Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 16:34:52 +0200 Subject: [PATCH 028/149] CI: fix early termination GitHub accepted previous code, & did passed the steps, but somehow ... long story short, it was pretending to have early termination working, while it just was always skipping those steps silently. So, `index-state` needs another +1s. --- .github/workflows/caching.yml | 6 +++--- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index d605e24d3e..76c7fd6dac 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -158,11 +158,11 @@ jobs: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- ${{ env.cache-name }}-${{ runner.os }}- - - if: (! steps.compiled-deps.outputs.cache-hit) + - if: steps.compiled-deps.outputs.cache-hit != 'true' run: | cabal update - - if: (! steps.compiled-deps.outputs.cache-hit) + - if: steps.compiled-deps.outputs.cache-hit != 'true' name: Download all sources run: | cabal $cabalBuild --only-download @@ -172,7 +172,7 @@ jobs: # but to cache what can be cached, so step is fault tolerant & would always succseed. # 2021-12-11: NOTE: Building all targets, since # current Cabal does not allow `all --enable-tests --enable-benchmarks --only-dependencies` - - if: (! steps.compiled-deps.outputs.cache-hit) + - if: steps.compiled-deps.outputs.cache-hit != 'true' name: Build all targets; try 3 times continue-on-error: true run: | diff --git a/cabal-ghc901.project b/cabal-ghc901.project index c536524a45..9dc81d3b56 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:10Z +index-state: 2021-11-29T12:30:11Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index a33387dece..b5a0c813aa 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:02Z +index-state: 2021-12-18T00:00:03Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index ffc53d8fae..c109f3ef75 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:10Z +index-state: 2021-11-29T12:30:11Z constraints: hyphenation +embed From 064a9b79950cded8a3f991c4fb03a6796b8fa1b7 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 16:52:41 +0200 Subject: [PATCH 029/149] WIP: PLEASE, DROP BEFORE MERGE --- .github/workflows/caching.yml | 3 +++ cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index 76c7fd6dac..ae08b0a89c 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -164,6 +164,9 @@ jobs: - if: steps.compiled-deps.outputs.cache-hit != 'true' name: Download all sources + # 2021-12-21: FIXME: Please, remove `continue-on-error: true` before merge. + # This was added because Cabal meets unsolvable constraints: https://github.com/haskell/haskell-language-server/runs/4596155381?check_suite_focus=true + continue-on-error: true run: | cabal $cabalBuild --only-download diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 9dc81d3b56..e0a7d7adc1 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:11Z +index-state: 2021-11-29T12:30:12Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index b5a0c813aa..80ecd6979d 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:03Z +index-state: 2021-12-18T00:00:04Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index c109f3ef75..81640c9de9 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:11Z +index-state: 2021-11-29T12:30:12Z constraints: hyphenation +embed From 29ffa8093ff27b19d5fc4e77e35d4d0bda2988cc Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:12:25 +0200 Subject: [PATCH 030/149] WIP: PLEASE, DROP BEFORE MERGE This reverts commit 064a9b79950cded8a3f991c4fb03a6796b8fa1b7. --- .github/workflows/caching.yml | 3 --- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 4 files changed, 3 insertions(+), 6 deletions(-) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index ae08b0a89c..76c7fd6dac 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -164,9 +164,6 @@ jobs: - if: steps.compiled-deps.outputs.cache-hit != 'true' name: Download all sources - # 2021-12-21: FIXME: Please, remove `continue-on-error: true` before merge. - # This was added because Cabal meets unsolvable constraints: https://github.com/haskell/haskell-language-server/runs/4596155381?check_suite_focus=true - continue-on-error: true run: | cabal $cabalBuild --only-download diff --git a/cabal-ghc901.project b/cabal-ghc901.project index e0a7d7adc1..9dc81d3b56 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:12Z +index-state: 2021-11-29T12:30:11Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 80ecd6979d..b5a0c813aa 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:04Z +index-state: 2021-12-18T00:00:03Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index 81640c9de9..c109f3ef75 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:12Z +index-state: 2021-11-29T12:30:11Z constraints: hyphenation +embed From e86f64a64ccf6c4cbc0c62afe54545cb1c098cd0 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:18:46 +0200 Subject: [PATCH 031/149] WIP: PLEASE, DROP THIS COMMIT BEFORE MERGE This reverts commit 208f4844f44af7368014d7872916473ae31deebd. --- .github/workflows/bench.yml | 9 ++++----- .github/workflows/test.yml | 9 ++++----- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index b197613949..a79b1a969b 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -9,11 +9,10 @@ concurrency: group: ${{ github.head_ref }}-${{ github.workflow }} cancel-in-progress: true -# 2021-12-21: FIXME: Revert this to enable test build, which now would be with hot cache -# on: -# pull_request: -# branches: -# - '**' +on: + pull_request: + branches: + - '**' jobs: pre_job: diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 877c39da0d..f1e8551e0b 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -9,11 +9,10 @@ concurrency: group: ${{ github.head_ref }}-${{ github.workflow }} cancel-in-progress: true -# 2021-12-21: FIXME: Revert this to enable test build, which now would be with hot cache -# on: -# pull_request: -# branches: -# - '**' +on: + pull_request: + branches: + - '**' jobs: pre_job: From cca1db9a38c8de58783a39bb58971f0a08863c1c Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:20:19 +0200 Subject: [PATCH 032/149] WIP: PLEASE, DROP THIS COMMIT BEFORE MERGE This reverts commit ba4d618ba50033fc0b0e628344f09b8cd5a80e55. --- .github/workflows/caching.yml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index 76c7fd6dac..ed46371389 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -42,10 +42,6 @@ on: # Reinstitution of the main chache puts it back into FIFO # & so it gets shared across all PRs. - cron: "25 2/8 * * *" - # 2021-12-21: FIXME: Remove this endry before merge. - pull_request: - branches: - - '**' env: cabalBuild: "v2-build all --enable-tests --enable-benchmarks" From 2f56989f7871f17d2a410c9db23efc122238aa98 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:21:56 +0200 Subject: [PATCH 033/149] CI: index-state advance to save cache anew --- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 9dc81d3b56..1ba83fd801 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:11Z +index-state: 2021-11-29T12:30:14Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index b5a0c813aa..4bf7f10e19 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:03Z +index-state: 2021-12-18T00:00:05Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index c109f3ef75..e394e2239a 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:11Z +index-state: 2021-11-29T12:30:14Z constraints: hyphenation +embed From 936c236520a790cc630e2ab2f3ea8678e8c535ef Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:30:26 +0200 Subject: [PATCH 034/149] CI: apparently GitHub uses alias cp='cp -i' Another day, another bug. --- .github/workflows/test.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index f1e8551e0b..b186335df3 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -95,10 +95,12 @@ jobs: - if: matrix.ghc == '9.0.1' name: (GHC 9.0.1) Use modified `cabal.project` run: | + rm cabal.project cp cabal-ghc901.project cabal.project - if: matrix.ghc == '9.2.1' name: (GHC 9.2.1) Use modified `cabal.project` run: | + rm cabal.project cp cabal-ghc921.project cabal.project - if: runner.os == 'Windows' && matrix.ghc == '8.8.4' name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults From 1f8ff21825707d28807e41b079dc0865d765b0d1 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:35:17 +0200 Subject: [PATCH 035/149] WIP: PLESE, REVERT TO TEST ALL GHCs --- .github/workflows/test.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index b186335df3..e5c1d188e5 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -40,7 +40,7 @@ jobs: strategy: fail-fast: true matrix: - ghc: ["9.2.1", "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] + ghc: ["9.2.1"] # , "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] os: [ubuntu-latest, macOS-latest] cabal: ['3.6'] include: From 1d58237966c079d2e5f638ae3d0b2a9d0b09db55 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:36:48 +0200 Subject: [PATCH 036/149] CI: index-state +1s --- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 1ba83fd801..fcaf7bd309 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:14Z +index-state: 2021-11-29T12:30:15Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 4bf7f10e19..9ad3f54086 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:05Z +index-state: 2021-12-18T00:00:06Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index e394e2239a..d622fdb1af 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:14Z +index-state: 2021-11-29T12:30:15Z constraints: hyphenation +embed From e1ce5425bdfbdeff711a043a2e6becf71e3a7bd8 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:38:59 +0200 Subject: [PATCH 037/149] WIP: PLESE, REVERT TO TEST ALL GHCs --- .github/workflows/test.yml | 56 +++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index e5c1d188e5..04582bb5dc 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -43,34 +43,34 @@ jobs: ghc: ["9.2.1"] # , "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] os: [ubuntu-latest, macOS-latest] cabal: ['3.6'] - include: - # only test supported ghc major versions - - os: ubuntu-latest - ghc: '9.0.1' - test: true - - os: ubuntu-latest - ghc: '8.10.7' - test: true - - os: ubuntu-latest - ghc: '8.8.4' - test: true - - os: ubuntu-latest - ghc: '8.6.5' - test: true - - os: windows-latest - ghc: '9.0.1' - test: true - - os: windows-latest - ghc: '8.10.7' - test: true - - os: windows-latest - ghc: '8.6.5' - test: true - # only build rest of supported ghc versions for windows - - os: windows-latest - ghc: '8.10.6' - - os: windows-latest - ghc: '8.8.4' + # include: + # # only test supported ghc major versions + # - os: ubuntu-latest + # ghc: '9.0.1' + # test: true + # - os: ubuntu-latest + # ghc: '8.10.7' + # test: true + # - os: ubuntu-latest + # ghc: '8.8.4' + # test: true + # - os: ubuntu-latest + # ghc: '8.6.5' + # test: true + # - os: windows-latest + # ghc: '9.0.1' + # test: true + # - os: windows-latest + # ghc: '8.10.7' + # test: true + # - os: windows-latest + # ghc: '8.6.5' + # test: true + # # only build rest of supported ghc versions for windows + # - os: windows-latest + # ghc: '8.10.6' + # - os: windows-latest + # ghc: '8.8.4' steps: - uses: actions/checkout@v2 From 8f35c00373853c79eb7413b8cd1a84ff4550ec6d Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:39:51 +0200 Subject: [PATCH 038/149] CI: index-state +1s --- cabal-ghc901.project | 2 +- cabal-ghc921.project | 2 +- cabal.project | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index fcaf7bd309..ddae8fea3c 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -37,7 +37,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:15Z +index-state: 2021-11-29T12:30:16Z constraints: -- These plugins don't work on GHC9 yet diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 9ad3f54086..f7f944d884 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:06Z +index-state: 2021-12-18T00:00:07Z constraints: -- These plugins doesn't work on GHC92 yet diff --git a/cabal.project b/cabal.project index d622fdb1af..3029ee7cfe 100644 --- a/cabal.project +++ b/cabal.project @@ -40,7 +40,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:15Z +index-state: 2021-11-29T12:30:16Z constraints: hyphenation +embed From 870f3c253eee9d43d15301219b813fcc47340b92 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 21 Dec 2021 17:40:59 +0200 Subject: [PATCH 039/149] WIP: PLESE, REVERT TO PASS HLINT CI REQUIREMENTS --- .github/workflows/test.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 04582bb5dc..8dc28b538a 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -148,9 +148,9 @@ jobs: - run: cabal update - - name: "HLint via ./fmt.sh" - run: | - ./fmt.sh + # - name: "HLint via ./fmt.sh" + # run: | + # ./fmt.sh # repeating builds to workaround segfaults in windows and ghc-8.8.4 - name: Build From e5d3b12116ef104776e9a4eef6302d86e780926a Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 22 Dec 2021 13:17:14 +0100 Subject: [PATCH 040/149] Enable tests for ghc-9.2.1 --- .github/workflows/test.yml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 8dc28b538a..3fb73c73f9 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -45,6 +45,9 @@ jobs: cabal: ['3.6'] # include: # # only test supported ghc major versions + - os: ubuntu-latest + ghc: '9.2.1' + test: true # - os: ubuntu-latest # ghc: '9.0.1' # test: true @@ -57,6 +60,9 @@ jobs: # - os: ubuntu-latest # ghc: '8.6.5' # test: true + - os: windows-latest + ghc: '9.2.1' + test: true # - os: windows-latest # ghc: '9.0.1' # test: true @@ -97,11 +103,13 @@ jobs: run: | rm cabal.project cp cabal-ghc901.project cabal.project + - if: matrix.ghc == '9.2.1' name: (GHC 9.2.1) Use modified `cabal.project` run: | rm cabal.project cp cabal-ghc921.project cabal.project + - if: runner.os == 'Windows' && matrix.ghc == '8.8.4' name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults run: | From 10f18b622dc43f01c2b26a980c26516f01c31e43 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 22 Dec 2021 13:18:19 +0100 Subject: [PATCH 041/149] Use cabal-ghc921.project --- .github/workflows/caching.yml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index ed46371389..7cd1bdeb18 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -100,7 +100,15 @@ jobs: - if: matrix.ghc == '9.0.1' name: (GHC 9.0.1) Use modified `cabal.project` run: | + rm cabal.project cp cabal-ghc901.project cabal.project + + - if: matrix.ghc == '9.2.1' + name: (GHC 9.2.1) Use modified `cabal.project` + run: | + rm cabal.project + cp cabal-ghc921.project cabal.project + - if: runner.os == 'Windows' && matrix.ghc == '8.8.4' name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults run: | @@ -170,6 +178,5 @@ jobs: # current Cabal does not allow `all --enable-tests --enable-benchmarks --only-dependencies` - if: steps.compiled-deps.outputs.cache-hit != 'true' name: Build all targets; try 3 times - continue-on-error: true run: | cabal $cabalBuild || cabal $cabalBuild || cabal $cabalBuild From 54978e7f903997736ad8752148105aec17f46b7b Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 22 Dec 2021 13:22:46 +0100 Subject: [PATCH 042/149] Enable tests for all ghcs To check changes for ghc-9.2.1 do not break other ghcs --- .github/workflows/test.yml | 70 +++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 3fb73c73f9..5f42d6b8a5 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -40,43 +40,43 @@ jobs: strategy: fail-fast: true matrix: - ghc: ["9.2.1"] # , "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] + ghc: ["9.2.1", "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] os: [ubuntu-latest, macOS-latest] cabal: ['3.6'] - # include: - # # only test supported ghc major versions - - os: ubuntu-latest - ghc: '9.2.1' - test: true - # - os: ubuntu-latest - # ghc: '9.0.1' - # test: true - # - os: ubuntu-latest - # ghc: '8.10.7' - # test: true - # - os: ubuntu-latest - # ghc: '8.8.4' - # test: true - # - os: ubuntu-latest - # ghc: '8.6.5' - # test: true + include: + # only test supported ghc major versions + - os: ubuntu-latest + ghc: '9.2.1' + test: true + - os: ubuntu-latest + ghc: '9.0.1' + test: true + - os: ubuntu-latest + ghc: '8.10.7' + test: true + - os: ubuntu-latest + ghc: '8.8.4' + test: true + - os: ubuntu-latest + ghc: '8.6.5' + test: true - os: windows-latest ghc: '9.2.1' test: true - # - os: windows-latest - # ghc: '9.0.1' - # test: true - # - os: windows-latest - # ghc: '8.10.7' - # test: true - # - os: windows-latest - # ghc: '8.6.5' - # test: true - # # only build rest of supported ghc versions for windows - # - os: windows-latest - # ghc: '8.10.6' - # - os: windows-latest - # ghc: '8.8.4' + - os: windows-latest + ghc: '9.0.1' + test: true + - os: windows-latest + ghc: '8.10.7' + test: true + - os: windows-latest + ghc: '8.6.5' + test: true + # only build rest of supported ghc versions for windows + - os: windows-latest + ghc: '8.10.6' + - os: windows-latest + ghc: '8.8.4' steps: - uses: actions/checkout@v2 @@ -156,9 +156,9 @@ jobs: - run: cabal update - # - name: "HLint via ./fmt.sh" - # run: | - # ./fmt.sh + - name: "HLint via ./fmt.sh" + run: | + ./fmt.sh # repeating builds to workaround segfaults in windows and ghc-8.8.4 - name: Build From 15e1878dd52a959a92be6b01a4b09850d23fe90b Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 22 Dec 2021 13:45:11 +0100 Subject: [PATCH 043/149] Address or skip hlint --- ghcide/.hlint.yaml | 2 ++ ghcide/src/Development/IDE/GHC/ExactPrint.hs | 11 +++++------ ghcide/src/Development/IDE/LSP/Outline.hs | 1 - ghcide/src/Development/IDE/Plugin/CodeAction.hs | 15 +++++++-------- 4 files changed, 14 insertions(+), 15 deletions(-) diff --git a/ghcide/.hlint.yaml b/ghcide/.hlint.yaml index 4f271f5e7d..52354291b3 100644 --- a/ghcide/.hlint.yaml +++ b/ghcide/.hlint.yaml @@ -114,6 +114,8 @@ - Development.IDE.Spans.AtPoint - Development.IDE.Spans.Pragmas - Development.IDE.Plugin.CodeAction + - Development.IDE.Plugin.CodeAction.Args + - Development.IDE.Plugin.CodeAction.ExactPrint - Development.IDE.Plugin.Completions - Development.IDE.Plugin.Completions.Logic - Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 9b9c491071..c9ecde56ac 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -256,7 +255,7 @@ graft' needs_space dst val = Graft $ \dflags a -> do ( mkT $ \case (L src _ :: LocatedAn l ast) - | (locA src) `eqSrcSpan` dst -> val' + | locA src `eqSrcSpan` dst -> val' l -> l ) a @@ -290,7 +289,7 @@ getNeedsSpaceAndParenthesize dst a = let (needs_parens, needs_space) = everythingWithContext (Nothing, Nothing) (<>) ( mkQ (mempty, ) $ \x s -> case x of - (L src _ :: LHsExpr GhcPs) | (locA src) `eqSrcSpan` dst -> + (L src _ :: LHsExpr GhcPs) | locA src `eqSrcSpan` dst -> (s, s) L _ x' -> (mempty, Just *** Just $ needsParensSpace x') ) a @@ -346,7 +345,7 @@ graftWithM dst trans = Graft $ \dflags a -> do ( mkM $ \case val@(L src _ :: LocatedAn l ast) - | (locA src) `eqSrcSpan` dst -> do + | locA src `eqSrcSpan` dst -> do mval <- trans val case mval of Just val' -> do @@ -405,7 +404,7 @@ graftDecls dst decs0 = Graft $ \dflags a -> do annotateDecl dflags decl let go [] = DL.empty go (L src e : rest) - | (locA src) `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest + | locA src `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest | otherwise = DL.singleton (L src e) <> go rest modifyDeclsT (pure . DL.toList . go) a @@ -418,7 +417,7 @@ graftSmallestDeclsWithM :: graftSmallestDeclsWithM dst toDecls = Graft $ \dflags a -> do let go [] = pure DL.empty go (e@(L src _) : rest) - | dst `isSubspanOf` (locA src) = toDecls e >>= \case + | dst `isSubspanOf` locA src = toDecls e >>= \case Just decs0 -> do decs <- forM decs0 $ \decl -> annotateDecl dflags decl diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 586643a4f4..b972c67692 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -18,7 +18,6 @@ import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat (ParsedModule(..)) import Development.IDE.GHC.Error (rangeToRealSrcSpan, realSrcSpanToRange) import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 034137b629..1e4e6d5803 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -3,7 +3,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DuplicateRecordFields #-} -- | Go to the definition of a variable. @@ -191,7 +190,7 @@ findSigOfBind range bind = go (HsDo _ _ stmts) = do stmtlr <- unLoc <$> findDeclContainingLoc (_start range) (unLoc stmts) case stmtlr of - LetStmt _ lhsLocalBindsLR -> findSigOfBinds range $ lhsLocalBindsLR + LetStmt _ lhsLocalBindsLR -> findSigOfBinds range lhsLocalBindsLR _ -> Nothing go _ = Nothing @@ -428,7 +427,7 @@ suggestDeleteUnusedBinding | otherwise = [] where relatedRanges indexedContent name = - concatMap (findRelatedSpans indexedContent name) $ map reLoc hsmodDecls + concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDecls toRange = realSrcSpanToRange extendForSpaces = extendToIncludePreviousNewlineIfPossible @@ -443,7 +442,7 @@ suggestDeleteUnusedBinding findSig _ = [] in extendForSpaces indexedContent (toRange l) : - concatMap findSig (map reLoc hsmodDecls) + concatMap (findSig . reLoc) hsmodDecls _ -> concatMap (findRelatedSpanForMatch indexedContent name) matches findRelatedSpans _ _ _ = [] @@ -522,7 +521,7 @@ suggestDeleteUnusedBinding then let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig findSig _ = [] - in extendForSpaces indexedContent (toRange l) : concatMap findSig (map reLoc lsigs) + in extendForSpaces indexedContent (toRange l) : concatMap (findSig . reLoc) lsigs else concatMap (findRelatedSpanForMatch indexedContent name) matches findRelatedSpanForHsBind _ _ _ _ = [] @@ -552,7 +551,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul (\(L (locA -> l) b) -> if maybe False isTopLevel $ srcSpanToRange l then exportsAs b else Nothing) $ hsmodDecls - , Just pos <- fmap _end . getLocatedRange =<< fmap reLoc hsmodExports + , Just pos <- (fmap _end . getLocatedRange) . reLoc =<< hsmodExports , Just needComma <- needsComma source <$> fmap reLoc hsmodExports , let exportName = (if needComma then "," else "") <> printExport exportType name insertPos = pos {_character = pred $ _character pos} @@ -595,8 +594,8 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul exportsAs (ValD _ FunBind {fun_id}) = Just (ExportName, reLoc fun_id) exportsAs (ValD _ (PatSynBind _ PSB {psb_id})) = Just (ExportPattern, reLoc psb_id) exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, reLoc tcdLName) - exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, reLoc $ tcdLName) - exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, reLoc $ tcdLName) + exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName) + exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName) exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportAll, reLoc $ fdLName tcdFam) exportsAs _ = Nothing From 49f76a11f78f06f1890b85db77089579084621cd Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 22 Dec 2021 13:49:07 +0100 Subject: [PATCH 044/149] Last hlint fixes --- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 4 ++-- ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index c9ecde56ac..49eebe704f 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -313,7 +313,7 @@ graftExprWithM dst trans = Graft $ \dflags a -> do ( mkM $ \case val@(L src _ :: LHsExpr GhcPs) - | (locA src) `eqSrcSpan` dst -> do + | locA src `eqSrcSpan` dst -> do mval <- trans val case mval of Just val' -> do @@ -435,7 +435,7 @@ graftDeclsWithM :: graftDeclsWithM dst toDecls = Graft $ \dflags a -> do let go [] = pure DL.empty go (e@(L src _) : rest) - | (locA src) `eqSrcSpan` dst = toDecls e >>= \case + | locA src `eqSrcSpan` dst = toDecls e >>= \case Just decs0 -> do decs <- forM decs0 $ \decl -> hoistTransform (either Fail.fail pure) $ diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index b173953726..aa89746c09 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -433,7 +433,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) #if !MIN_VERSION_ghc(9,2,0) when hasSibling $ addTrailingCommaT (head pre) - let parentLIE = L srcParent $ (if isParentOperator then IEType parentRdr else IEName parentRdr) + let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr) childLIE = reLocA $ L srcChild $ IEName childRdr #else let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType mempty parentRdr else IEName parentRdr) From dc9b643bd3ce5758eba410a1aa710b9ecfc3d6f1 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 23 Dec 2021 00:39:12 +0530 Subject: [PATCH 045/149] Fix loop when setting DynFlags --- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index dfce6d1841..c245195c79 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -103,12 +103,7 @@ setHomeUnitId_ uid df = df { thisInstalledUnitId = toInstalledUnitId uid } #endif hscSetFlags :: DynFlags -> HscEnv -> HscEnv -hscSetFlags df env = -#if MIN_VERSION_ghc(9,2,0) - hscSetFlags df env -#else - env { Env.hsc_dflags = df } -#endif +hscSetFlags df env = env { Env.hsc_dflags = df } initTempFs :: HscEnv -> IO HscEnv initTempFs env = do From b0a16e978661cf430b4f0e6d5dbcea1f9321e812 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 23 Dec 2021 00:53:34 +0530 Subject: [PATCH 046/149] Filter out evidence variables in documentHighlight --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 36bdd58303..69e19a822c 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -158,7 +158,13 @@ documentHighlight -> MaybeT m [DocumentHighlight] documentHighlight hf rf pos = pure highlights where - ns = concat $ pointCommand hf pos (rights . M.keys . getNodeIds) +#if MIN_VERSION_ghc(9,0,1) + -- We don't want to show document highlights for evidence variables, which are supposed to be invisible + notEvidence = not . any isEvidenceContext . identInfo +#else + notEvidence = const True +#endif + ns = concat $ pointCommand hf pos (rights . M.keys . M.filter notEvidence . getNodeIds) highlights = do n <- ns ref <- fromMaybe [] (M.lookup (Right n) rf) From a82462049d55aeb520917e613bfaab9b188b7bcf Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 21:33:51 +0000 Subject: [PATCH 047/149] Fix getFlds --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d12dbd8e4a..7ee1392ec4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -488,10 +488,10 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result ] doc = SpanDocText (getDocumentation [pmod] $ reLoc tcdLName) (SpanDocUris Nothing Nothing) - getFlds :: HsConDeclH98Details GhcPs -> Maybe [ConDeclField GhcPs] + -- getFlds :: HsConDeclH98Details GhcPs -> Maybe [ConDeclField GhcPs] getFlds conArg = case conArg of RecCon rec -> Just $ unLoc <$> unLoc rec - PrefixCon _ _ -> Just [] + PrefixCon{} -> Just [] _ -> Nothing extract ConDeclField{..} From a759949bd40be429a3abef9273124d812206534f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 21:58:30 +0000 Subject: [PATCH 048/149] fix GRE --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 25 ++++++++++++++++--- .../src/Development/IDE/Plugin/CodeAction.hs | 4 +-- .../IDE/Plugin/Completions/Logic.hs | 5 ++-- 3 files changed, 26 insertions(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 491ab82cb8..8f63a3a616 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -290,6 +290,11 @@ module Development.IDE.GHC.Compat.Core ( -- * Other GHC.CoreModule(..), GHC.SafeHaskellMode(..), + pattern GRE, + gre_name, + gre_imp, + gre_lcl, + gre_par, -- * Util Module re-exports #if MIN_VERSION_ghc(9,0,0) module GHC.Builtin.Names, @@ -352,6 +357,7 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Types.Name.Env, module GHC.Types.Name.Reader, #if MIN_VERSION_ghc(9,2,0) + module GHC.Types.Avail, module GHC.Types.SourceFile, module GHC.Types.SourceText, module GHC.Types.TyThing, @@ -536,6 +542,7 @@ import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, import GHC.Tc.Utils.TcType as TcType import qualified GHC.Types.Avail as Avail #if MIN_VERSION_ghc(9,2,0) +import GHC.Types.Avail (greNamePrintableName) import GHC.Types.Fixity (LexicalFixity (..)) #endif #if MIN_VERSION_ghc(9,2,0) @@ -546,7 +553,8 @@ import GHC.Types.Id import GHC.Types.Name hiding (varName) import GHC.Types.Name.Cache import GHC.Types.Name.Env -import GHC.Types.Name.Reader +import GHC.Types.Name.Reader hiding (GRE, gre_name, gre_imp, gre_lcl, gre_par) +import qualified GHC.Types.Name.Reader as RdrName #if MIN_VERSION_ghc(9,2,0) import GHC.Types.Name.Set import GHC.Types.SourceFile (HscSource (..), @@ -661,7 +669,8 @@ import Plugins import PprTyThing hiding (pprFamInst) import PrelInfo import PrelNames hiding (Unique, printName) -import RdrName +import RdrName hiding (GRE, gre_name, gre_imp, gre_lcl, gre_par) +import qualified RdrName import RnNames import RnSplice import qualified SrcLoc @@ -969,7 +978,7 @@ isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLoc a) (GHC.getLoc b) #if MIN_VERSION_ghc(9,2,0) type LocatedAn a = GHC.LocatedAn a #else -type LocatedAn a = Located +type LocatedAn a = GHC.Located #endif #if MIN_VERSION_ghc(9,2,0) @@ -996,3 +1005,13 @@ type NameAnn = GHC.NameAnn #else type NameAnn = SrcLoc.SrcSpan #endif + +pattern GRE :: Name -> Parent -> Bool -> [ImportSpec] -> RdrName.GlobalRdrElt +{-# COMPLETE GRE #-} +#if MIN_VERSION_ghc(9,2,0) +pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE + {gre_name = (greNamePrintableName -> gre_name) + ,gre_par, gre_lcl, gre_imp} +#else +pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} +#endif diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index ce854dcaf1..2d3a0e3d5f 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -291,7 +291,7 @@ isUnusedImportedId ], [GRE {gre_name = name}] <- lookupGlobalRdrEnv rdrEnv occ, importedIdentifier <- Right name, - refs <- M.lookup (fmap greNameMangledName importedIdentifier) refMap = + refs <- M.lookup importedIdentifier refMap = maybe True (not . any (\(_, IdentifierDetails {..}) -> identInfo == S.singleton Use)) refs | otherwise = False @@ -738,7 +738,7 @@ suggestModuleTypo Diagnostic{_range=_range,..} extractModule line = case T.words line of [modul, "(from", _] -> Just modul _ -> Nothing - + suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)] suggestFillHole Diagnostic{_range=_range,..} diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 7ee1392ec4..d40016a02b 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -54,7 +54,6 @@ import Language.LSP.Types.Capabilities import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score_), original) -import GHC.Types.Avail (greNamePrintableName) -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int @@ -357,8 +356,8 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do getComplsForOne :: GlobalRdrElt -> IO ([CompItem],QualCompls) getComplsForOne (GRE n par True _) = - (, mempty) <$> toCompItem par curMod curModNameText (greNamePrintableName n) Nothing - getComplsForOne (GRE (greNamePrintableName -> n) par False prov) = + (, mempty) <$> toCompItem par curMod curModNameText n Nothing + getComplsForOne (GRE n par False prov) = flip foldMapM (map is_decl prov) $ \spec -> do let originalImportDecl = do -- we don't want to extend import if it's already in scope From 927903e16723eeeba94bf87314637c053f3d7dba Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 21:58:37 +0000 Subject: [PATCH 049/149] fix formatting --- ghcide/src/Development/IDE/GHC/Compat/Parser.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index f7716f861d..e842053070 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -129,7 +129,11 @@ pattern ParsedModule } <- ( (,()) -> (GHC.ParsedModule{..}, pm_annotations)) where ParsedModule ms parsed extra_src_files _anns = - GHC.ParsedModule { pm_mod_summary = ms , pm_parsed_source = parsed , pm_extra_src_files = extra_src_files } + GHC.ParsedModule + { pm_mod_summary = ms + , pm_parsed_source = parsed + , pm_extra_src_files = extra_src_files + } #endif mkApiAnns :: PState -> ApiAnns From 7b51175ca519b5387cb2f4556e4309b6ad046d5e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:03:35 +0000 Subject: [PATCH 050/149] fix Compat build in 9.0 --- ghcide/src/Development/IDE/GHC/Compat.hs | 1 + ghcide/src/Development/IDE/GHC/Compat/Core.hs | 7 +++---- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 5422a9b251..32858dd1ac 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -80,6 +80,7 @@ import Development.IDE.GHC.Compat.Util #if MIN_VERSION_ghc(9,0,0) import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) +import GHC.Utils.Error #if MIN_VERSION_ghc(9,2,0) import GHC.Unit.Module.ModSummary import GHC.Driver.Env as Env diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 8f63a3a616..342df3ba9e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -967,11 +967,10 @@ setOutputFile f d = d { #endif } +isSubspanOfA :: LocatedAn la a -> LocatedAn lb b -> Bool #if MIN_VERSION_ghc(9,2,0) -isSubspanOfA :: GHC.LocatedAn la a -> GHC.LocatedAn lb b -> Bool isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLocA a) (GHC.getLocA b) #else -isSubspanOfA :: Located a -> Located b -> Bool isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLoc a) (GHC.getLoc b) #endif @@ -990,8 +989,8 @@ locA = id #if MIN_VERSION_ghc(9,2,0) getLocA = GHC.getLocA #else -getLocA :: HasSrcSpan a => a -> SrcSpan -getLocA = GHC.getLoc +-- getLocA :: HasSrcSpan a => a -> SrcSpan +getLocA x = GHC.getLoc x #endif #if MIN_VERSION_ghc(9,2,0) From f17cd06f609d9721aac1ea81906e3a11ff0566ec Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:09:08 +0000 Subject: [PATCH 051/149] fix collectHsBindsBinders --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 10 +++++++++- ghcide/src/Development/IDE/Plugin/TypeLenses.hs | 2 +- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 342df3ba9e..342d665fb4 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -295,6 +295,9 @@ module Development.IDE.GHC.Compat.Core ( gre_imp, gre_lcl, gre_par, +#if MIN_VERSION_ghc(9,2,0) + collectHsBindsBinders, +#endif -- * Util Module re-exports #if MIN_VERSION_ghc(9,0,0) module GHC.Builtin.Names, @@ -500,7 +503,8 @@ import GHC.Hs.Extension import GHC.Hs.ImpExp import GHC.Hs.Pat import GHC.Hs.Type -import GHC.Hs.Utils +import GHC.Hs.Utils hiding (collectHsBindsBinders) +import qualified GHC.Hs.Utils as GHC #endif #if !MIN_VERSION_ghc(9,2,0) import GHC.Hs @@ -1014,3 +1018,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE #else pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} #endif + +#if MIN_VERSION_ghc(9,2,0) +collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x +#endif diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index b3ec458b55..ee565070cb 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -253,7 +253,7 @@ gblBindingType :: Maybe HscEnv -> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeS gblBindingType (Just hsc) (Just gblEnv) = do let exports = availsToNameSet $ tcg_exports gblEnv sigs = tcg_sigs gblEnv - binds = collectHsBindsBinders CollNoDictBinders $ tcg_binds gblEnv + binds = collectHsBindsBinders $ tcg_binds gblEnv patSyns = tcg_patsyns gblEnv rdrEnv = tcg_rdr_env gblEnv showDoc = showDocRdrEnv hsc rdrEnv From 20ec3d5d03cdc812b7d0235d1bec504ed6d7e850 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:13:54 +0000 Subject: [PATCH 052/149] remove redundant WarnMsg local typedef --- ghcide/src/Development/IDE/GHC/Compat.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 32858dd1ac..b5798df216 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -144,7 +144,6 @@ hPutStringBuffer hdl (StringBuffer buf len cur) #if MIN_VERSION_ghc(9,2,0) type ErrMsg = MsgEnvelope DecoratedSDoc -type WarnMsg = MsgEnvelope DecoratedSDoc #endif getErrorMessages' :: PState -> DynFlags -> Bag ErrMsg From 78d93d1df2b663c62944f6b9c6a8d72fd07e3a2a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:32:50 +0000 Subject: [PATCH 053/149] showSDocForUser --- ghcide/src/Development/IDE/GHC/Compat/Units.hs | 12 ++++++++++++ ghcide/src/Development/IDE/Plugin/TypeLenses.hs | 5 ++--- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index b2c227a286..d4a51becbd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -46,12 +46,14 @@ module Development.IDE.GHC.Compat.Units ( -- * Utils filterInplaceUnits, FinderCache, + showSDocForUser', ) where #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Data.ShortText as ST import GHC.Driver.Env (hsc_unit_dbs) +import GHC.Driver.Ppr import GHC.Unit.Env import GHC.Unit.External import GHC.Unit.Finder @@ -67,9 +69,11 @@ import GHC.Unit.State (LookupResult, UnitInfo, import qualified GHC.Unit.State as State import GHC.Unit.Types hiding (moduleUnit, toUnitId) import qualified GHC.Unit.Types as Unit +import GHC.Utils.Outputable #else import qualified DynFlags import FastString +import GhcPlugins (SDoc, showSDocForUser) import HscTypes import Module hiding (moduleUnitId) import qualified Module @@ -89,6 +93,7 @@ import Data.Map (Map) #endif import Data.Either import Data.Version +import qualified GHC #if MIN_VERSION_ghc(9,0,0) type PreloadUnitClosure = UniqSet UnitId @@ -340,3 +345,10 @@ filterInplaceUnits us packageFlags = else Right p #endif isInplace p = Right p + +showSDocForUser' :: HscEnv -> GHC.PrintUnqualified -> SDoc -> String +#if MIN_VERSION_ghc(9,2,0) +showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env) +#else +showSDocForUser' env = showSDocForUser (hsc_dflags env) +#endif diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index ee565070cb..e098c5a6c8 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -26,8 +26,7 @@ import qualified Data.Text as T import Development.IDE (GhcSession (..), HscEnvEq (hscEnv), RuleResult, Rules, define, - srcSpanToRange, - tmrModSummary) + srcSpanToRange) import Development.IDE.Core.Compile (TcModuleResult (..)) import Development.IDE.Core.RuleTypes (GetBindings (GetBindings), TypeCheck (TypeCheck)) @@ -216,7 +215,7 @@ instance A.FromJSON Mode where -------------------------------------------------------------------------------- showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String -showDocRdrEnv env rdrEnv = showSDocForUser (hsc_dflags env) (unitState env) (mkPrintUnqualifiedDefault env rdrEnv) +showDocRdrEnv env rdrEnv = showSDocForUser' env (mkPrintUnqualifiedDefault env rdrEnv) data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs deriving (Generic, Show, Eq, Ord, Hashable, NFData) From 813d991a012aabe22cc087c1e7c445df459ca466 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:40:37 +0000 Subject: [PATCH 054/149] redundant import --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 2d3a0e3d5f..23dc7e86c7 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -79,7 +79,6 @@ import Language.LSP.VFS import Text.Regex.TDFA (mrAfter, (=~), (=~~)) -import GHC.Types.Avail (greNameMangledName) ------------------------------------------------------------------------------------------------- -- | Generate code actions. From c2588704e415e6635d361163d65ed27b72b7c4b3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:42:05 +0000 Subject: [PATCH 055/149] HsLet --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 342d665fb4..624a1e1f55 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -108,6 +108,10 @@ module Development.IDE.GHC.Compat.Core ( CgGuts(..), -- * ModDetails ModDetails(..), + -- * HsExpr, +#if !MIN_VERSION_ghc(9,2,0) + pattern Development.IDE.GHC.Compat.Core.HsLet, +#endif -- * Var Type ( TyCoRep.TyVarTy, @@ -507,7 +511,7 @@ import GHC.Hs.Utils hiding (collectHsBindsBinders) import qualified GHC.Hs.Utils as GHC #endif #if !MIN_VERSION_ghc(9,2,0) -import GHC.Hs +import GHC.Hs hiding (HsLet) #endif import GHC.HsToCore.Docs import GHC.HsToCore.Expr @@ -620,7 +624,7 @@ import FamInst import FamInstEnv import Finder #if MIN_VERSION_ghc(8,10,0) -import GHC.Hs +import GHC.Hs hiding (HsLet) #endif import qualified GHCi import GhcMonad @@ -1022,3 +1026,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} #if MIN_VERSION_ghc(9,2,0) collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x #endif + +#if !MIN_VERSION_ghc(9,2,0) +pattern HsLet xlet localBinds expr <- GHC.HsLet xlet (SrcLoc.unLoc -> localBinds) expr +#endif From 30564720ea5ae048d360244173af0ef478609ab8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:47:51 +0000 Subject: [PATCH 056/149] LetStmt --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 624a1e1f55..d39bdef1a8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -110,7 +110,8 @@ module Development.IDE.GHC.Compat.Core ( ModDetails(..), -- * HsExpr, #if !MIN_VERSION_ghc(9,2,0) - pattern Development.IDE.GHC.Compat.Core.HsLet, + pattern HsLet, + pattern LetStmt, #endif -- * Var Type ( @@ -511,7 +512,7 @@ import GHC.Hs.Utils hiding (collectHsBindsBinders) import qualified GHC.Hs.Utils as GHC #endif #if !MIN_VERSION_ghc(9,2,0) -import GHC.Hs hiding (HsLet) +import GHC.Hs hiding (HsLet, LetStmt) #endif import GHC.HsToCore.Docs import GHC.HsToCore.Expr @@ -624,7 +625,7 @@ import FamInst import FamInstEnv import Finder #if MIN_VERSION_ghc(8,10,0) -import GHC.Hs hiding (HsLet) +import GHC.Hs hiding (HsLet, LetStmt) #endif import qualified GHCi import GhcMonad @@ -1029,4 +1030,5 @@ collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x #if !MIN_VERSION_ghc(9,2,0) pattern HsLet xlet localBinds expr <- GHC.HsLet xlet (SrcLoc.unLoc -> localBinds) expr +pattern LetStmt xlet localBinds <- GHC.LetStmt xlet (SrcLoc.unLoc -> localBinds) #endif From e937268163927789a3d6a96250bb8d2471a405a8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:48:23 +0000 Subject: [PATCH 057/149] fix Completions build --- ghcide/src/Development/IDE/Plugin/Completions.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 2a60f62534..55f1f5f90f 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} module Development.IDE.Plugin.Completions ( descriptor @@ -25,7 +25,7 @@ import Development.IDE.Core.Service import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (rangeToSrcSpan) -import Development.IDE.GHC.ExactPrint (Annotated(..), +import Development.IDE.GHC.ExactPrint (Annotated (..), GetAnnotatedParsedSource (GetAnnotatedParsedSource), astA) import Development.IDE.GHC.Util (prettyPrint) @@ -257,7 +257,14 @@ extendImportHandler' ideState ExtendImport {..} it = case thingParent of Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" - t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents) + t <- liftMaybe $ snd <$> newImportToEdit + n +#if !MIN_VERSION_ghc(9,2,0) + (astA ps) +#else + ps +#endif + (fromMaybe "" contents) return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero From 1d547f20fccd8c9801ce7c82a4c0bf45644adeeb Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 22:48:48 +0000 Subject: [PATCH 058/149] bump cabal index state --- cabal-ghc921.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 94795f5d37..f7f944d884 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2021-11-29T12:30:10Z +index-state: 2021-12-18T00:00:07Z constraints: -- These plugins doesn't work on GHC92 yet From c4d1ab600f8c1dc159dd7332acd933953db111d6 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:23:50 +0000 Subject: [PATCH 059/149] Literals: replace argument patterns by field patterns Sadly this is not enough to fix the build --- .../src/Ide/Plugin/Literals.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs index 61a8367e1b..59c4457648 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs @@ -82,10 +82,10 @@ fromOverLit OverLit{..} sSpan = case ol_val of fromOverLit _ _ = Nothing fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal -fromIntegralLit s (IL txt _ val) = fmap (\txt' -> IntLiteral s txt' val) (fromSourceText txt) +fromIntegralLit s IL{..} = fmap (\txt' -> IntLiteral s txt' il_value) (fromSourceText il_text) fromFractionalLit :: RealSrcSpan -> FractionalLit -> Maybe Literal -fromFractionalLit s (FL txt _ val) = fmap (\txt' -> FracLiteral s txt' val) (fromSourceText txt) +fromFractionalLit s FL{..} = fmap (\txt' -> FracLiteral s txt' fl_value) (fromSourceText fl_text) fromSourceText :: SourceText -> Maybe Text fromSourceText = \case @@ -115,6 +115,6 @@ literalToString = \case overLitToString :: OverLitVal -> String overLitToString = \case - HsIntegral int -> case int of { IL _ _ val -> "IntegralOverLit: " <> show val } - HsFractional frac -> case frac of { FL _ _ val -> "RationalOverLit: " <> show val } + HsIntegral int -> case int of { IL{il_value} -> "IntegralOverLit: " <> show il_value} + HsFractional frac -> case frac of { FL{fl_value} -> "RationalOverLit: " <> show fl_value} HsIsString _ str -> "HIsString: " <> show str From 7f361880cc2d0cb3c43d28209c066a8d1ab546cc Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:24:23 +0000 Subject: [PATCH 060/149] QualifyImportedNames: fix build with ghc <9.2 --- .../src/Ide/Plugin/QualifyImportedNames.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index af27f15c92..f144dc818c 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -27,10 +27,9 @@ import Development.IDE.Core.RuleTypes (GetFileContents (GetFileCont TypeCheck (TypeCheck)) import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (IdeState, use) -import Development.IDE.GHC.Compat (ContextInfo (Use), +import Development.IDE.GHC.Compat (ContextInfo (Use), GRE, GenLocated (..), GhcPs, - GlobalRdrElt (GRE, gre_imp, gre_name), - GlobalRdrEnv, + GlobalRdrElt, GlobalRdrEnv, HsModule (hsmodImports), Identifier, IdentifierDetails (IdentifierDetails, identInfo), @@ -42,6 +41,7 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), RefMap, Span, SrcSpan, TcGblEnv (tcg_rdr_env), emptyUFM, globalRdrEnvElts, + gre_imp, gre_name, lookupNameEnv, moduleNameString, nameOccName, occNameString, From 9ab613c762cdd0f04f7f92adf1c3c500183c1038 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:01:37 +0000 Subject: [PATCH 061/149] fix <9.2 build Splice plugin --- .../src/Ide/Plugin/Splice.hs | 20 ++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 4e51e59b69..14ce391783 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -15,6 +15,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} module Ide.Plugin.Splice ( descriptor, @@ -134,7 +136,7 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do graftSpliceWith :: forall ast. - HasSplice ast => + HasSplice AnnListItem ast => Maybe (SrcSpan, Located (ast GhcPs)) -> Maybe (Either String WorkspaceEdit) graftSpliceWith expandeds = @@ -273,27 +275,27 @@ findSubSpansDesc srcSpan = ) data SpliceClass where - OneToOneAST :: HasSplice ast => Proxy# ast -> SpliceClass + OneToOneAST :: HasSplice AnnListItem ast => Proxy# ast -> SpliceClass IsHsDecl :: SpliceClass -class (Outputable (ast GhcRn), ASTElement (ast GhcPs)) => HasSplice ast where +class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast where type SpliceOf ast :: Kinds.Type -> Kinds.Type type SpliceOf ast = HsSplice matchSplice :: Proxy# ast -> ast GhcPs -> Maybe (SpliceOf ast GhcPs) expandSplice :: Proxy# ast -> SpliceOf ast GhcPs -> RnM (Either (ast GhcPs) (ast GhcRn), FreeVars) -instance HasSplice HsExpr where +instance HasSplice AnnListItem HsExpr where matchSplice _ (HsSpliceE _ spl) = Just spl matchSplice _ _ = Nothing expandSplice _ = fmap (first Right) . rnSpliceExpr -instance HasSplice Pat where +instance HasSplice AnnListItem Pat where matchSplice _ (SplicePat _ spl) = Just spl matchSplice _ _ = Nothing expandSplice _ = rnSplicePat -instance HasSplice HsType where +instance HasSplice AnnListItem HsType where matchSplice _ (HsSpliceTy _ spl) = Just spl matchSplice _ _ = Nothing expandSplice _ = fmap (first Right) . rnSpliceType @@ -366,8 +368,8 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e -- | FIXME: Is thereAny "clever" way to do this exploiting TTG? unRenamedE :: - forall ast m. - (Fail.MonadFail m, HasSplice ast) => + forall ast m l. + (Fail.MonadFail m, HasSplice l ast) => DynFlags -> ast GhcRn -> TransformT m (Located (ast GhcPs)) @@ -375,7 +377,7 @@ unRenamedE dflags expr = do uniq <- show <$> uniqueSrcSpanT (anns, expr') <- either (fail . show) pure $ - parseAST @(ast GhcPs) dflags uniq $ + parseAST @_ @(ast GhcPs) dflags uniq $ showSDoc dflags $ ppr expr let _anns' = setPrecedingLines expr' 0 1 anns pure expr' From ef6355d73b09f3946645402383877a08467c6606 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:02:22 +0000 Subject: [PATCH 062/149] fix <9.2 build QualifyImportedNames plugin --- .../src/Ide/Plugin/QualifyImportedNames.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index f144dc818c..ba851534e4 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -27,7 +28,7 @@ import Development.IDE.Core.RuleTypes (GetFileContents (GetFileCont TypeCheck (TypeCheck)) import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (IdeState, use) -import Development.IDE.GHC.Compat (ContextInfo (Use), GRE, +import Development.IDE.GHC.Compat (ContextInfo (Use), GenLocated (..), GhcPs, GlobalRdrElt, GlobalRdrEnv, HsModule (hsmodImports), @@ -45,7 +46,8 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), GRE, lookupNameEnv, moduleNameString, nameOccName, occNameString, - plusUFM_C, srcSpanEndCol, + pattern GRE, plusUFM_C, + srcSpanEndCol, srcSpanEndLine, srcSpanStartCol, srcSpanStartLine, unitUFM) From be3abcba201ca12088ccdab33ec371a88a1cf827 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:19:50 +0000 Subject: [PATCH 063/149] Fix <9.2 build Wingman --- plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index 647d6cd60b..f80f950b33 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -193,9 +193,9 @@ pattern AMatch ctx pats body <- pattern SingleLet :: IdP GhcPs -> [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs pattern SingleLet bind pats val expr <- HsLet _ - (L _ (HsValBinds _ + (HsValBinds _ (ValBinds _ (bagToList -> - [(L _ (FunBind _ (L _ bind) (MG _ (L _ [L _ (AMatch _ pats val)]) _) _ _))]) _))) + [(L _ (FunBind _ (L _ bind) (MG _ (L _ [L _ (AMatch _ pats val)]) _) _ _))]) _)) (L _ expr) From 783ce07f3ebd3f47fbd127935340f1239f01c116 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:21:46 +0000 Subject: [PATCH 064/149] fix build example --- plugins/default/src/Ide/Plugin/Example.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 89bef3441e..6fbbaad67a 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -27,7 +27,7 @@ import Data.Typeable import Development.IDE as D import Development.IDE.Core.Shake (getDiagnostics, getHiddenDiagnostics) -import Development.IDE.GHC.Compat (ParsedModule (ParsedModule)) +import Development.IDE.GHC.Compat import GHC.Generics import Ide.PluginUtils import Ide.Types From f033a63ffbfbbb17f606342599a40a0e714ed506 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 22 Dec 2021 23:27:06 +0000 Subject: [PATCH 065/149] Disable a whole bunch of plugins --- cabal-ghc921.project | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index f7f944d884..9ef93aab80 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -11,12 +11,12 @@ packages: -- ./plugins/hls-stylish-haskell-plugin -- ./plugins/hls-fourmolu-plugin ./plugins/hls-class-plugin - ./plugins/hls-eval-plugin - ./plugins/hls-explicit-imports-plugin + -- ./plugins/hls-eval-plugin + -- ./plugins/hls-explicit-imports-plugin ./plugins/hls-refine-imports-plugin - -- ./plugins/hls-hlint-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-haddock-comments-plugin + -- ./plugins/hls-hlint-plugin + -- ./plugins/hls-retrie-plugin + -- ./plugins/hls-haddock-comments-plugin -- ./plugins/hls-splice-plugin ./plugins/hls-qualify-imported-names-plugin -- ./plugins/hls-floskell-plugin @@ -24,7 +24,7 @@ packages: ./plugins/hls-module-name-plugin -- ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin - ./plugins/hls-alternate-number-format-plugin + -- ./plugins/hls-alternate-number-format-plugin source-repository-package type: git @@ -56,7 +56,26 @@ index-state: 2021-12-18T00:00:07Z constraints: -- These plugins doesn't work on GHC92 yet - haskell-language-server +ignore-plugins-ghc-bounds -brittany -class -fourmolu -splice -stylishhaskell -tactic -refineImports -callhierarchy -hlint -ormolu -floskell, + haskell-language-server + +ignore-plugins-ghc-bounds + -alternateNumberFormat + -brittany + -callhierarchy + -class + -eval + -floskell + -fourmolu + -haddockComments + -hlint + -importLens + -moduleName + -ormolu + -qualifyImportedNames + -refineImports + -retrie + -splice + -stylishhaskell + -tactic, ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, primitive-extras ==0.10.1.2, From d2207728c87f7e765996e534ef297b7c99c0bcb1 Mon Sep 17 00:00:00 2001 From: "Junyoung \"Clare\" Jang" Date: Wed, 22 Dec 2021 18:52:11 -0500 Subject: [PATCH 066/149] Move windows test into the matrix --- .github/workflows/test.yml | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 84e1486610..44a53a5767 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -41,7 +41,7 @@ jobs: fail-fast: true matrix: ghc: ["9.2.1", "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] - os: [ubuntu-latest, macOS-latest] + os: [ubuntu-latest, macOS-latest, windows-latest] cabal: ['3.6'] include: # only test supported ghc major versions @@ -72,11 +72,6 @@ jobs: - os: windows-latest ghc: '8.6.5' test: true - # only build rest of supported ghc versions for windows - - os: windows-latest - ghc: '8.10.6' - - os: windows-latest - ghc: '8.8.4' steps: - uses: actions/checkout@v2 From 28d0fb08ef12c7fea1ef64426d746462e662f80a Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 23 Dec 2021 12:22:07 +0100 Subject: [PATCH 067/149] Make consistent plugin handling package commented out <-> flags <-> test suite --- .github/workflows/test.yml | 12 ++++++------ cabal-ghc921.project | 8 ++------ 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 44a53a5767..932a093c46 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -204,14 +204,14 @@ jobs: run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" - if: matrix.test - name: Test hls-class-plugin && matrix.ghc != '9.2.1' + name: Test hls-class-plugin run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-eval-plugin run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || cabal test hls-eval-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-haddock-comments-plugin run: cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" @@ -239,7 +239,7 @@ jobs: name: Test hls-refine-imports-plugin test suite run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" @@ -247,7 +247,7 @@ jobs: name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" @@ -255,7 +255,7 @@ jobs: name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-alternate-number-format-plugin test suite run: cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 9ef93aab80..8a60c4e8a2 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -15,6 +15,7 @@ packages: -- ./plugins/hls-explicit-imports-plugin ./plugins/hls-refine-imports-plugin -- ./plugins/hls-hlint-plugin + -- ./plugins/hls-rename-plugin -- ./plugins/hls-retrie-plugin -- ./plugins/hls-haddock-comments-plugin -- ./plugins/hls-splice-plugin @@ -76,6 +77,7 @@ constraints: -splice -stylishhaskell -tactic, + -importLens, ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, primitive-extras ==0.10.1.2, @@ -109,9 +111,3 @@ allow-newer: diagrams:diagrams-core, Chart-diagrams:diagrams-core, SVGFonts:diagrams-core, - - -- for head.hackage - primitive-unlifted:base - -allow-older: - primitive-extras:primitive-unlifted From c9d3e9856e1d3604b16b93b15c1d386cfd8d1c15 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 23 Dec 2021 12:23:36 +0100 Subject: [PATCH 068/149] Add a not working stack.yaml for ghc-9.2.1 It starts to build though --- stack-9.2.1.yaml | 121 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 121 insertions(+) create mode 100644 stack-9.2.1.yaml diff --git a/stack-9.2.1.yaml b/stack-9.2.1.yaml new file mode 100644 index 0000000000..690e8a1a03 --- /dev/null +++ b/stack-9.2.1.yaml @@ -0,0 +1,121 @@ +resolver: nightly-2021-12-22 +compiler: ghc-9.2.1 + +packages: +- . +- ./hie-compat +- ./hls-graph +- ./ghcide/ +- ./hls-plugin-api +- ./hls-test-utils +- ./shake-bench +- ./plugins/hls-call-hierarchy-plugin +- ./plugins/hls-class-plugin +# - ./plugins/hls-haddock-comments-plugin +# - ./plugins/hls-eval-plugin +- ./plugins/hls-explicit-imports-plugin +- ./plugins/hls-qualify-imported-names-plugin +- ./plugins/hls-refine-imports-plugin +# - ./plugins/hls-hlint-plugin +# - ./plugins/hls-rename-plugin +# - ./plugins/hls-retrie-plugin +# - ./plugins/hls-splice-plugin +# - ./plugins/hls-tactics-plugin +# - ./plugins/hls-brittany-plugin +# - ./plugins/hls-stylish-haskell-plugin +# - ./plugins/hls-floskell-plugin +# - ./plugins/hls-fourmolu-plugin +- ./plugins/hls-pragmas-plugin +- ./plugins/hls-module-name-plugin +# - ./plugins/hls-ormolu-plugin +# - ./plugins/hls-alternate-number-format-plugin + +extra-deps: + +# ghc-9.2 specific +# boot packages +- Cabal-3.6.2.0 +- directory-1.3.7.0 +- ghc-boot-9.2.1 +- process-1.6.13.2 +- time-1.12.1 + + +- bytestring-encoding-0.1.1.0 +- dependent-map-0.4.0.0 +- dependent-sum-0.7.1.0 +- extra-1.7.9 # for ghcide, https://github.com/haskell/haskell-language-server/pull/2131 +- hspec-2.7.10 # for hls-test-utils +- hspec-core-2.7.10 # for hls-test-utils +- some-1.0.2 # for dependent-sum, https://github.com/obsidiansystems/dependent-sum/issues/66 +- dependent-sum-template-0.1.1.1 +- floskell-0.10.6 +- heapsize-0.3.0.1 +- hiedb-0.4.1.0 +- implicit-hie-0.1.2.6 +- implicit-hie-cradle-0.3.0.5 +- monad-dijkstra-0.1.1.3 +- retrie-1.1.0.0 +- lsp-1.2.0.1 +- lsp-types-1.3.0.1 +- lsp-test-0.14.0.1 + +# shake-bench dependencies +- Chart-1.9.3 +- Chart-diagrams-1.9.3 +- SVGFonts-1.7.0.1 # for Chart-diagrams, https://github.com/timbod7/haskell-chart/issues/232 +- diagrams-postscript-1.5 +- statestack-0.3 +- operational-0.2.4.1 + +# currently needed for ghcide>extra, etc. +allow-newer: true + +ghc-options: + "$everything": -haddock + +configure-options: + ghcide: + - --disable-library-for-ghci + haskell-language-server: + - --disable-library-for-ghci + heapsize: + - --disable-library-for-ghci + +flags: + haskell-language-server: + pedantic: true + + ignore-plugins-ghc-bounds: true + alternateNumberFormat: false + brittany: false + callhierarchy: false + class: false + eval: false + floskell: false + fourmolu: false + haddockComments: false + hlint: false + importLens: false + moduleName: false + ormolu: false + qualifyImportedNames: false + refineImports: false + retrie: false + splice: false + stylishhaskell: false + tactic: false + importLens: false + + retrie: + BuildExecutable: false + # Stack doesn't support automatic flags. + # hls-hlint-plugin: + # hlint33: true + hyphenation: + embed: true + +nix: + packages: [ icu libcxx zlib ] + +concurrent-tests: false From 6a6a7787e17c218df8df6ff3b2e48c2d3837a0fa Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 23 Dec 2021 12:40:31 +0100 Subject: [PATCH 069/149] Remove wrong comma --- cabal-ghc921.project | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 8a60c4e8a2..8043dea3e0 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -18,7 +18,7 @@ packages: -- ./plugins/hls-rename-plugin -- ./plugins/hls-retrie-plugin -- ./plugins/hls-haddock-comments-plugin - -- ./plugins/hls-splice-plugin + -- ./plugins/hls-splice-plugin ./plugins/hls-qualify-imported-names-plugin -- ./plugins/hls-floskell-plugin ./plugins/hls-pragmas-plugin @@ -76,7 +76,7 @@ constraints: -retrie -splice -stylishhaskell - -tactic, + -tactic -importLens, ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, @@ -110,4 +110,4 @@ allow-newer: dependent-sum:constraints, diagrams:diagrams-core, Chart-diagrams:diagrams-core, - SVGFonts:diagrams-core, + SVGFonts:diagrams-core From 1cad251feb5fc6a34fc281f81288c4010988228e Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 23 Dec 2021 14:10:18 +0100 Subject: [PATCH 070/149] Restore primitive allow-* --- cabal-ghc921.project | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 8043dea3e0..9c25499197 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -110,4 +110,10 @@ allow-newer: dependent-sum:constraints, diagrams:diagrams-core, Chart-diagrams:diagrams-core, - SVGFonts:diagrams-core + SVGFonts:diagrams-core, + + -- for head.hackage + primitive-unlifted:base + +allow-older: + primitive-extras:primitive-unlifted From 3d42563035cc704a26d466aded3202a0dfe71d05 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 23 Dec 2021 18:02:36 +0000 Subject: [PATCH 071/149] Use correct UnitId when constructing InstalledModules --- ghcide/src/Development/IDE/Core/Compile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 13f99ddb2a..7f4d04a7ad 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -680,7 +680,7 @@ loadModulesHome mod_infos e = mergeEnvs :: HscEnv -> [ModSummary] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv mergeEnvs env extraModSummaries extraMods envs = do prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs - let ims = map (Compat.installedModule (homeUnitId_ $ hsc_dflags env) . moduleName . ms_mod) extraModSummaries + let ims = map (\ms -> Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))) extraModSummaries ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims -- We don't do any instantiation for backpack at this point of time, so it is OK to use -- 'extendModSummaryNoDeps'. From ef11f4d32c5eaf9f096efa381ff56930cfe2818e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 23 Dec 2021 20:10:38 +0000 Subject: [PATCH 072/149] Fix 8.8 build --- ghcide/src/Development/IDE/Core/Compile.hs | 20 +++--------- ghcide/src/Development/IDE/GHC/Compat.hs | 32 ++++++++++++------- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 4 +-- 3 files changed, 26 insertions(+), 30 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 7f4d04a7ad..e0bb4701ab 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -819,13 +819,8 @@ parseHeader parseHeader dflags filename contents = do let loc = mkRealSrcLoc (Util.mkFastString filename) 1 1 case unP Compat.parseHeader (initParserState (initParserOpts dflags) contents loc) of -#if MIN_VERSION_ghc(8,10,0) - PFailed pst -> - throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages' pst dflags -#else - PFailed _ locErr msgErr -> - throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr -#endif + PFailedWithErrorMessages msgs -> + throwE $ diagFromErrMsgs "parser" dflags $ msgs dflags POk pst rdr_module -> do let (warns, errs) = getMessages' pst dflags @@ -858,14 +853,7 @@ parseFileContents env customPreprocessor filename ms = do dflags = ms_hspp_opts ms contents = fromJust $ ms_hspp_buf ms case unP Compat.parseModule (initParserState (initParserOpts dflags) contents loc) of -#if MIN_VERSION_ghc(8,10,0) - PFailed pst -> throwE - $ diagFromErrMsgs "parser" dflags - $ getErrorMessages' pst dflags -#else - PFailed _ locErr msgErr -> - throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr -#endif + PFailedWithErrorMessages msgs -> throwE $ diagFromErrMsgs "parser" dflags $ msgs dflags POk pst rdr_module -> let hpm_annotations = mkApiAnns pst @@ -1015,7 +1003,7 @@ getDocsBatch hsc_env _mod _names = do Map.findWithDefault mempty name amap)) case res of Just x -> return $ map (first $ T.unpack . showGhc) x - Nothing -> throwErrors + Nothing -> throwErrors #if MIN_VERSION_ghc(9,2,0) $ Error.getErrorMessages msgs #else diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index b5798df216..a0779964a8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -4,6 +4,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PatternSynonyms #-} {-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-} -- | Attempt at hiding the GHC version differences we can. @@ -17,8 +18,8 @@ module Development.IDE.GHC.Compat( disableWarningsAsErrors, reLoc, reLocA, - getErrorMessages', getMessages', + pattern PFailedWithErrorMessages, #if !MIN_VERSION_ghc(9,0,1) RefMap, @@ -82,6 +83,7 @@ import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) import GHC.Utils.Error #if MIN_VERSION_ghc(9,2,0) +import Data.Bifunctor import GHC.Unit.Module.ModSummary import GHC.Driver.Env as Env import GHC.Unit.Module.ModIface @@ -121,12 +123,15 @@ import Data.IORef import qualified Data.Map as Map import Data.List (foldl') -import Data.Bifunctor #if MIN_VERSION_ghc(9,0,0) import qualified Data.Set as S #endif +#if !MIN_VERSION_ghc(8,10,0) +import Bag (unitBag) +#endif + #if !MIN_VERSION_ghc(9,2,0) reLoc :: Located a -> Located a reLoc = id @@ -146,16 +151,6 @@ hPutStringBuffer hdl (StringBuffer buf len cur) type ErrMsg = MsgEnvelope DecoratedSDoc #endif -getErrorMessages' :: PState -> DynFlags -> Bag ErrMsg -getErrorMessages' pst dflags = -#if MIN_VERSION_ghc(9,2,0) - fmap pprError $ -#endif - getErrorMessages pst -#if !MIN_VERSION_ghc(9,2,0) - dflags -#endif - getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg) getMessages' pst dflags = #if MIN_VERSION_ghc(9,2,0) @@ -166,6 +161,19 @@ getMessages' pst dflags = dflags #endif +-- pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a +pattern PFailedWithErrorMessages msgs +#if MIN_VERSION_ghc(9,2,0) + <- PFailed (const . fmap pprError . getErrorMessages -> msgs) +#elif MIN_VERSION_ghc(8,10,0) + <- PFailed (getErrorMessages -> msgs) +#else + <- ((fmap.fmap) unitBag . mkPlainErrMsgIfPFailed -> Just msgs) +{-# COMPLETE PFailedWithErrorMessages #-} + +mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err) +mkPlainErrMsgIfPFailed _ = Nothing +#endif supportsHieFiles :: Bool supportsHieFiles = True diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index d39bdef1a8..57544e1b42 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -638,12 +638,12 @@ import HscTypes import HsBinds import HsDecls import HsDoc -import HsExpr +import HsExpr hiding (HsLet, LetStmt) import HsExtension import HsImpExp import HsLit import HsPat -import HsSyn hiding (wildCardName) +import HsSyn hiding (wildCardName, HsLet, LetStmt) import HsTypes hiding (wildCardName) import HsUtils #endif From 567a325eb191381eb06a89c1ae5508bc16bf280a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 07:13:23 +0000 Subject: [PATCH 073/149] Fix hls-test-utils --- hls-test-utils/src/Test/Hls.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 1b1fdc1c6b..018e6d52a1 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RecordWildCards #-} module Test.Hls ( module Test.Tasty.HUnit, From 41f3510c64c30a3a552c6a8ef2696dd5f0ff8187 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 08:52:26 +0000 Subject: [PATCH 074/149] Build explicit imports plugin --- .github/workflows/test.yml | 2 +- cabal-ghc921.project | 3 +-- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 13 +++++++++++-- .../src/Ide/Plugin/ExplicitImports.hs | 15 ++++++++------- 4 files changed, 21 insertions(+), 12 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index aa3115b7d8..1df69feec6 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -243,7 +243,7 @@ jobs: name: Test hls-refine-imports-plugin test suite run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.1' + - if: matrix.test name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 9c25499197..90398c193a 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -12,7 +12,7 @@ packages: -- ./plugins/hls-fourmolu-plugin ./plugins/hls-class-plugin -- ./plugins/hls-eval-plugin - -- ./plugins/hls-explicit-imports-plugin + ./plugins/hls-explicit-imports-plugin ./plugins/hls-refine-imports-plugin -- ./plugins/hls-hlint-plugin -- ./plugins/hls-rename-plugin @@ -68,7 +68,6 @@ constraints: -fourmolu -haddockComments -hlint - -importLens -moduleName -ormolu -qualifyImportedNames diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 57544e1b42..bc0e45b192 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -804,11 +804,20 @@ pattern FunTy arg res <- TyCoRep.FunTy arg res class HasSrcSpan a where getLoc :: a -> SrcSpan +instance HasSrcSpan SrcSpan where + getLoc = id + instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where getLoc = GHC.getLoc --- getLoc :: GenLocated l a -> l --- getLoc = GHC.getLoc +#if MIN_VERSION_ghc(9,2,0) +instance HasSrcSpan (SrcSpanAnn' ann) where + getLoc = locA +instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where + getLoc = getLoc . getLoc + +pattern L l a <- GHC.L (getLoc -> l) a +#endif #elif MIN_VERSION_ghc(8,8,0) type HasSrcSpan = SrcLoc.HasSrcSpan diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 94213dc183..5f5b13181e 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -6,7 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} - +{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.ExplicitImports ( descriptor @@ -42,7 +42,9 @@ importCommandId = "ImportLensCommand" -- | The "main" function of a plugin descriptor :: PluginId -> PluginDescriptor IdeState -descriptor = descriptorForModules (/= moduleName pRELUDE) +descriptor = + -- (almost) no one wants to see an explicit import list for Prelude + descriptorForModules (/= moduleName pRELUDE) descriptorForModules :: (ModuleName -> Bool) @@ -180,7 +182,7 @@ exportedModuleStrings :: ParsedModule -> [String] exportedModuleStrings ParsedModule{pm_parsed_source = L _ HsModule{..}} | Just export <- hsmodExports, exports <- unLoc export - = map show exports + = map prettyPrint exports exportedModuleStrings _ = [] minimalImportsRule :: Rules () @@ -194,7 +196,7 @@ minimalImportsRule = define $ \MinimalImports nfp -> do let importsMap = Map.fromList [ (realSrcSpanStart l, T.pack (prettyPrint i)) - | L (RealSrcSpan l _) i <- fromMaybe [] mbMinImports + | L (locA -> RealSrcSpan l _) i <- fromMaybe [] mbMinImports ] res = [ (i, Map.lookup (realSrcSpanStart l) importsMap) @@ -240,15 +242,14 @@ extractMinimalImports (Just hsc) (Just TcModuleResult {..}) = do notExported _ _ = False extractMinimalImports _ _ = return ([], Nothing) -mkExplicitEdit :: (ModuleName -> Bool) -> PositionMapping -> LImportDecl pass -> T.Text -> Maybe TextEdit -mkExplicitEdit pred posMapping (L src imp) explicit +mkExplicitEdit :: (ModuleName -> Bool) -> PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit +mkExplicitEdit pred posMapping (L (locA -> src) imp) explicit -- Explicit import list case | ImportDecl {ideclHiding = Just (False, _)} <- imp = Nothing | not (isQualifiedImport imp), RealSrcSpan l _ <- src, L _ mn <- ideclName imp, - -- (almost) no one wants to see an explicit import list for Prelude pred mn, Just rng <- toCurrentRange posMapping $ realSrcSpanToRange l = Just $ TextEdit rng explicit From e6296a497eff622bc944bdd2cdec8ecaaca20fc1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 08:59:29 +0000 Subject: [PATCH 075/149] Drop Windows build blocked on unix-compat --- .github/workflows/test.yml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 1df69feec6..c42be2c2e3 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -41,7 +41,7 @@ jobs: fail-fast: true matrix: ghc: ["9.2.1", "9.0.1", '8.10.7', '8.10.6', "8.8.4", "8.6.5"] - os: [ubuntu-latest, macOS-latest, windows-latest] + os: [ubuntu-latest, macOS-latest] cabal: ['3.6'] include: # only test supported ghc major versions @@ -60,9 +60,11 @@ jobs: - os: ubuntu-latest ghc: '8.6.5' test: true - - os: windows-latest - ghc: '9.2.1' - test: true + # Blocked on unix-compat + # https://github.com/jacobstanley/unix-compat/issues/52 + # - os: windows-latest + # ghc: '9.2.1' + # test: true - os: windows-latest ghc: '9.0.1' test: true From af7d5244b92c50e2406df70a881583599bced893 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 09:18:13 +0000 Subject: [PATCH 076/149] bump Cabal index and simplify constraints --- cabal-ghc921.project | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 90398c193a..e3d8d4cee8 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -53,7 +53,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-18T00:00:07Z +index-state: 2021-12-23T00:00:00Z constraints: -- These plugins doesn't work on GHC92 yet @@ -79,15 +79,12 @@ constraints: -importLens, ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, - primitive-extras ==0.10.1.2, ghc-exactprint >= 1.3, retrie >= 1.2, lens >= 5.0.1, + primitive-unlifted ==0.1.3.1, -- these constraints are for head.hackage - primitive-unlifted < 1, aeson ==1.5.6.0, - primitive-unlifted ==0.1.3.0, - -- lens == 5.0.1 allow-newer: Cabal, From 5c68c79e42f5f5434b4c5a90e4419a43395db6e1 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 24 Dec 2021 11:19:02 +0000 Subject: [PATCH 077/149] Add comment --- ghcide/src/Development/IDE/Core/Compile.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index e0bb4701ab..3c95a3343d 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -310,6 +310,8 @@ compileModule (RunSimplifier simplify) session ms tcg = (warnings,desugared_guts) <- withWarnings "compile" $ \tweak -> do let session' = tweak (hscSetFlags (ms_hspp_opts ms) session) -- TODO: maybe settings ms_hspp_opts is unnecessary? + -- MP: the flags in ModSummary should be right, if they are wrong then + -- the correct place to fix this is when the ModSummary is created. desugar <- hscDesugar session' (ms { ms_hspp_opts = hsc_dflags session' }) tcg if simplify then do From e360035a95ac3abf28c25c0cc191400ec193ff00 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 24 Dec 2021 11:19:16 +0000 Subject: [PATCH 078/149] Use GhcSessionDeps in getHieAst --- ghcide/src/Development/IDE/Core/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index e24fa020bf..4e788902f2 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -519,7 +519,7 @@ getHieAstsRule :: Rules () getHieAstsRule = define $ \GetHieAst f -> do tmr <- use_ TypeCheck f - hsc <- hscEnv <$> use_ GhcSession f + hsc <- hscEnv <$> use_ GhcSessionDeps f getHieAstRuleDefinition f hsc tmr persistentHieFileRule :: Rules () From 452b736e88621757b4775a0b1228b6cdd3014939 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 24 Dec 2021 11:19:36 +0000 Subject: [PATCH 079/149] Use hsConDeclsBinders in Outline generation --- ghcide/src/Development/IDE/LSP/Outline.hs | 56 +++++++++++++++++++++-- 1 file changed, 53 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index b972c67692..711ee9936d 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -111,13 +111,21 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam { _name = showRdrName n , _kind = SkConstructor , _selectionRange = realSrcSpanToRange l' - , _children = conArgRecordFields (con_args x) + , _children = Just $ List $ childs } - | L (locA -> (RealSrcSpan l _ )) x <- dd_cons - , L (locA -> (RealSrcSpan l' _)) n <- getConNames' x + | con <- dd_cons + , let (cs, flds) = hsConDeclsBinders con + , let childs = mapMaybe cvtFld flds + , L (RealSrcSpan l' _) n <- cs ] } where + cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol + cvtFld (L (RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol) + { _name = showRdrName (unLoc (rdrNameFieldOcc n)) + , _kind = SkField + } + cvtFld _ = Nothing -- | Extract the record fields of a constructor conArgRecordFields (RecCon (L _ lcdfs)) = Just $ List [ (defDocumentSymbol l :: DocumentSymbol) @@ -244,3 +252,45 @@ getConNames' (XConDecl NoExt) = [] #elif !MIN_VERSION_ghc(9,0,0) getConNames' (XConDecl x) = noExtCon x #endif + +hsConDeclsBinders :: LConDecl GhcPs + -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs]) + -- See hsLTyClDeclBinders for what this does + -- The function is boringly complicated because of the records + -- And since we only have equality, we have to be a little careful +hsConDeclsBinders cons + = go cons + where + go :: LConDecl GhcPs + -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs]) + go r + -- Don't re-mangle the location of field names, because we don't + -- have a record of the full location of the field declaration anyway + = let loc = getLoc (reLoc r) + in case unLoc r of + -- remove only the first occurrence of any seen field in order to + -- avoid circumventing detection of duplicate fields (#9156) + ConDeclGADT { con_names = names, con_g_args = args } + -> (map (L loc . unLoc) names, flds) + where + (flds) = get_flds_gadt args + + ConDeclH98 { con_name = name, con_args = args } + -> ([L loc (unLoc name)], flds) + where + flds = get_flds_h98 args + + get_flds_h98 :: HsConDeclH98Details GhcPs + -> [LFieldOcc GhcPs] + get_flds_h98 (RecCon flds) = get_flds (reLoc flds) + get_flds_h98 _ = [] + + get_flds_gadt :: HsConDeclGADTDetails GhcPs + -> ([LFieldOcc GhcPs]) + get_flds_gadt (RecConGADT flds) = get_flds (reLoc flds) + get_flds_gadt _ = [] + + get_flds :: Located [LConDeclField GhcPs] + -> ([LFieldOcc GhcPs]) + get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) + From 61c657e957dd53039d2d8329015b609cb94b1719 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 24 Dec 2021 11:57:13 +0000 Subject: [PATCH 080/149] Use the right session in typecheckModule --- ghcide/src/Development/IDE/Core/Compile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 3c95a3343d..c18d377798 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -160,7 +160,7 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do -- TODO: maybe settings ms_hspp_opts is unnecessary? mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session} in - tcRnModule hsc keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} + tcRnModule session keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} let errorPipeline = unDefer . hideDiag dflags . tagDiag diags = map errorPipeline warnings deferedError = any fst diags From 937efe7325a44d7275feaaa239939be6f7342c83 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Fri, 24 Dec 2021 18:45:59 +0530 Subject: [PATCH 081/149] Restore some cases in Outline --- ghcide/src/Development/IDE/LSP/Outline.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 711ee9936d..997634a726 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -145,20 +145,26 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ ClsInstD { cid_ins = Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty , _kind = SkInterface } -#if !MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,2,0) +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl FamEqn { feqn_tycon, feqn_pats } })) +#else documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) +#endif = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords (map pprText feqn_pats) , _kind = SkInterface } +#if MIN_VERSION_ghc(9,2,0) +documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl _ FamEqn { feqn_tycon, feqn_pats } })) +#else documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) +#endif = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords (map pprText feqn_pats) , _kind = SkInterface } -#endif documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (DerivD _ DerivDecl { deriv_type })) = gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) -> (defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs) From bbb720f33669816d7ef6813fe12ec38d09fc49f3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 14:23:52 +0000 Subject: [PATCH 082/149] Fix Outline build with GHC <9.2 --- ghcide/src/Development/IDE/LSP/Outline.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 997634a726..8a65d14360 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -111,6 +111,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam { _name = showRdrName n , _kind = SkConstructor , _selectionRange = realSrcSpanToRange l' +#if MIN_VERSION_ghc(9,2,0) , _children = Just $ List $ childs } | con <- dd_cons @@ -126,6 +127,14 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , _kind = SkField } cvtFld _ = Nothing +#else + , _children = conArgRecordFields (con_args x) + } + | L (locA -> (RealSrcSpan l _ )) x <- dd_cons + , L (locA -> (RealSrcSpan l' _)) n <- getConNames' x + ] + } + where -- | Extract the record fields of a constructor conArgRecordFields (RecCon (L _ lcdfs)) = Just $ List [ (defDocumentSymbol l :: DocumentSymbol) @@ -136,6 +145,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , L (locA -> (RealSrcSpan l _)) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf ] conArgRecordFields _ = Nothing +#endif documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ SynDecl { tcdLName = L (locA -> (RealSrcSpan l' _)) n })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n , _kind = SkTypeParameter @@ -248,9 +258,6 @@ pprText = pack . showSDocUnsafe . ppr -- the version of getConNames for ghc9 is restricted to only the renaming phase #if !MIN_VERSION_ghc(9,2,0) getConNames' :: ConDecl GhcPs -> [Located (IdP GhcPs)] -#else -getConNames' :: ConDecl GhcPs -> [XRec GhcPs (IdP GhcPs)] -#endif getConNames' ConDeclH98 {con_name = name} = [name] getConNames' ConDeclGADT {con_names = names} = names #if !MIN_VERSION_ghc(8,10,0) @@ -258,7 +265,7 @@ getConNames' (XConDecl NoExt) = [] #elif !MIN_VERSION_ghc(9,0,0) getConNames' (XConDecl x) = noExtCon x #endif - +#else hsConDeclsBinders :: LConDecl GhcPs -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs]) -- See hsLTyClDeclBinders for what this does @@ -299,4 +306,4 @@ hsConDeclsBinders cons get_flds :: Located [LConDeclField GhcPs] -> ([LFieldOcc GhcPs]) get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) - +#endif From f951004021a2d3d688ea249a7f52ce087ac4e2f0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 14:27:58 +0000 Subject: [PATCH 083/149] Remove noisy logMessage notifications in tests I have never found these useful and they make it much harder to read logs. If there is a test that needs them, please use a custom logger instead of forcing this madness on everyone. --- ghcide/src/Development/IDE/Core/Shake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 0dda58478e..01a05f66bd 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -711,7 +711,7 @@ newSession extras@ShakeExtras{..} shakeDb acts reason = do ++ " (took " ++ showDuration runTime ++ ")" liftIO $ do logPriority logger (actionPriority d) msg - notifyTestingLogMessage extras msg + -- notifyTestingLogMessage extras msg -- The inferred type signature doesn't work in ghc >= 9.0.1 workRun :: (forall b. IO b -> IO b) -> IO (IO ()) From 111014ffb3e6d9cc76fac76ad2e269938552516b Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 16:02:00 +0000 Subject: [PATCH 084/149] Build ghcide test and bench suites with 9.2 --- ghcide/bench/lib/Experiments.hs | 1 + ghcide/ghcide.cabal | 2 +- ghcide/test/exe/Main.hs | 6 ++++++ 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs index 3aeed09e66..1230233164 100644 --- a/ghcide/bench/lib/Experiments.hs +++ b/ghcide/bench/lib/Experiments.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE PolyKinds #-} {-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-} module Experiments diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index e4095e239d..be7335bb63 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -407,7 +407,7 @@ test-suite ghcide-tests tasty-rerun, text, unordered-containers, - if (impl(ghc >= 8.6)) + if (impl(ghc >= 8.6) && impl(ghc < 9.2)) build-depends: record-dot-preprocessor, record-hasfield diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 6a366ebbdd..8da57c74eb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4075,6 +4075,7 @@ pluginSimpleTests = pluginParsedResultTests :: TestTree pluginParsedResultTests = ignoreInWindowsForGHC88And810 $ + ignoreForGHC92 $ testSessionWithExtraFiles "plugin-recorddot" "parsedResultAction plugin" $ \dir -> do _ <- openDoc (dir "RecordDot.hs") "haskell" expectNoMoreDiagnostics 2 @@ -5214,6 +5215,11 @@ ignoreInWindowsForGHC88And810 ignoreInWindowsBecause "tests are unreliable in windows for ghc 8.8 and 8.10" | otherwise = id +ignoreForGHC92 :: TestTree -> TestTree +ignoreForGHC92 + | ghcVersion == GHC92 = ignoreTestBecause "GHC 9.2" + | otherwise = id + ignoreInWindowsForGHC88 :: TestTree -> TestTree ignoreInWindowsForGHC88 | ghcVersion == GHC88 = From 338d31ffe6f3f9ae1f5293763f3abe533f936986 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 16:24:15 +0000 Subject: [PATCH 085/149] Revert "Merge branch 'master' into ghc-9.2" This reverts commit daf43c86e8f965ad0f61e0d6819eb03ae7ef3887, reversing changes made to f951004021a2d3d688ea249a7f52ce087ac4e2f0. --- .github/workflows/bench.yml | 12 +----------- .github/workflows/caching.yml | 24 ++++-------------------- .github/workflows/test.yml | 12 +----------- 3 files changed, 6 insertions(+), 42 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index c93758c823..a79b1a969b 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -74,15 +74,6 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - name: Form the package list ('cabal.project.freeze') - continue-on-error: true - run: | - cabal v2-freeze - echo '' - echo 'Output:' - echo '' - cat 'cabal.project.freeze' - - name: Hackage sources cache uses: actions/cache@v2 env: @@ -93,13 +84,12 @@ jobs: restore-keys: ${{ env.cache-name }}- - name: Compiled deps cache - id: compiled-deps uses: actions/cache@v2 env: cache-name: compiled-deps with: path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} + key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project') }} restore-keys: | ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index a27f58604f..4d5193853b 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -131,15 +131,6 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - name: Form the package list ('cabal.project.freeze') - continue-on-error: true - run: | - cabal v2-freeze - echo '' - echo 'Output:' - echo '' - cat 'cabal.project.freeze' - # 2021-12-02: NOTE: Cabal Hackage source tree storage does not depend on OS or GHC really, # but can depend on `base`. # But this caching is happens only inside `master` for `master` purposes of compiling the deps @@ -150,11 +141,9 @@ jobs: env: cache-name: hackage-sources with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} - restore-keys: | - ${{ env.cache-name }}-${{ env.INDEX_STATE }}- - ${{ env.cache-name }}- + path: ${{ env.CABAL_PKGS_DIR }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + restore-keys: ${{ env.cache-name }}- - name: Compiled deps cache id: compiled-deps @@ -163,7 +152,7 @@ jobs: cache-name: compiled-deps with: path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} + key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project') }} restore-keys: | ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- @@ -187,8 +176,3 @@ jobs: name: Build all targets; try 3 times run: | cabal $cabalBuild || cabal $cabalBuild || cabal $cabalBuild - - # Despite the `continue-on-error: true` directive - CI does not ignore the return code of the last step - - name: Workaround to CI platform - run: | - true diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 7d13da10f9..c42be2c2e3 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -132,15 +132,6 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - name: Form the package list ('cabal.project.freeze') - continue-on-error: true - run: | - cabal v2-freeze - echo '' - echo 'Output:' - echo '' - cat 'cabal.project.freeze' - - name: Hackage sources cache uses: actions/cache@v2 env: @@ -151,13 +142,12 @@ jobs: restore-keys: ${{ env.cache-name }}- - name: Compiled deps cache - id: compiled-deps uses: actions/cache@v2 env: cache-name: compiled-deps with: path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} + key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project') }} restore-keys: | ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- From 58bbc00a38459454f96520a6f51d81cd187ca139 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 17:29:48 +0000 Subject: [PATCH 086/149] The redundant constraints warning has changed in 9.2 --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 23dc7e86c7..21f57b2088 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1216,12 +1216,23 @@ removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..} then constraints & T.drop 1 & T.dropEnd 1 & T.strip else constraints +{- +9.2: "message": "/private/var/folders/4m/d38fhm3936x_gy_9883zbq8h0000gn/T/extra-dir-53173393699/Testing.hs:4:1: warning: + ⢠Redundant constraints: (Eq a, Show a) + ⢠In the type signature for: + foo :: forall a. (Eq a, Show a) => a -> Bool", + +9.0: "message": "⢠Redundant constraints: (Eq a, Show a) + ⢠In the type signature for: + foo :: forall a. (Eq a, Show a) => a -> Bool", +-} findRedundantConstraints :: T.Text -> Maybe [T.Text] findRedundantConstraints t = t & T.lines - & head - & T.strip - & (`matchRegexUnifySpaces` "Redundant constraints?: (.+)") + -- In <9.2 it's the first line, in 9.2 it' the second line + & take 2 + & mapMaybe ((`matchRegexUnifySpaces` "Redundant constraints?: (.+)") . T.strip) + & listToMaybe <&> (head >>> parseConstraints) formatConstraints :: [T.Text] -> T.Text From d72f9e0e183d61763de374c4db3ff719fc3823f5 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 17:51:39 +0000 Subject: [PATCH 087/149] Fix code action regression --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 21f57b2088..2d55ab7ee3 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -166,7 +166,8 @@ findSigOfBind range bind = findSigOfLMatch :: [LMatch p (LHsExpr p)] -> Maybe (Sig p) findSigOfLMatch ls = do match <- findDeclContainingLoc (_start range) ls - findSigOfGRHSs (getLoc $ reLoc match) (m_grhss (unLoc match)) + let rhs = m_grhss $ unLoc match + findSigOfGRHSs (getLoc $ reLoc $ grhssLocalBinds rhs ) rhs findSigOfGRHSs :: SrcSpan -> GRHSs p (LHsExpr p) -> Maybe (Sig p) findSigOfGRHSs span grhs = do From 1bed6d75846a6568c7d3dc81fbf64629abbabc34 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Dec 2021 18:37:21 +0000 Subject: [PATCH 088/149] fix 9.2 ghcide build --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 2d55ab7ee3..54cea63c66 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -167,7 +167,12 @@ findSigOfBind range bind = findSigOfLMatch ls = do match <- findDeclContainingLoc (_start range) ls let rhs = m_grhss $ unLoc match - findSigOfGRHSs (getLoc $ reLoc $ grhssLocalBinds rhs ) rhs +#if !MIN_VERSION_ghc(9,2,0) + span = getLoc $ reLoc $ grhssLocalBinds rhs +#else + span = getLoc $ reLoc $ match +#endif + findSigOfGRHSs span rhs findSigOfGRHSs :: SrcSpan -> GRHSs p (LHsExpr p) -> Maybe (Sig p) findSigOfGRHSs span grhs = do From d07f8f8f356e85006aa623c4014a64fa5064a704 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 27 Dec 2021 18:08:17 +0000 Subject: [PATCH 089/149] Fix completion snippets --- .../IDE/Plugin/Completions/Logic.hs | 23 ++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d40016a02b..827181522e 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -35,7 +35,8 @@ import Data.Ord (Down (Down)) import qualified Data.Set as Set import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat as GHC hiding (ppr) +import Development.IDE.GHC.Compat hiding (ppr) +import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util @@ -46,6 +47,15 @@ import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Exports import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Options + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Plugins (Depth (AllTheWay), + defaultSDocContext, + mkUserStyle, + neverQualify, + renderWithContext, + sdocStyle) +#endif import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), PluginId) @@ -254,10 +264,16 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = (TyVarTy _) -> noParensSnippet (LitTy _) -> noParensSnippet (TyConApp _ []) -> noParensSnippet - _ -> snippetText i ("(" <> showGhc t <> ")") + _ -> snippetText i ("(" <> showForSnippet t <> ")") where - noParensSnippet = snippetText i (showGhc t) + noParensSnippet = snippetText i (showForSnippet t) snippetText i t = "${" <> T.pack (show i) <> ":" <> t <> "}" +#if MIN_VERSION_ghc(9,2,0) + showForSnippet x = T.pack $ renderWithContext ctxt $ GHC.ppr x -- FIXme + ctxt = defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay} +#else + showForSnippet x = showGhc x +#endif getArgs :: Type -> [Type] getArgs t | isPredTy t = [] @@ -277,6 +293,7 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = #endif | otherwise = [] + mkModCompl :: T.Text -> CompletionItem mkModCompl label = CompletionItem label (Just CiModule) Nothing Nothing From 926d5d28b6be800434591428c3d9dde9c27ab83f Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Wed, 29 Dec 2021 12:36:41 +0000 Subject: [PATCH 090/149] Fix mismerge --- .github/workflows/caching.yml | 34 ---------------------------------- 1 file changed, 34 deletions(-) diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index 03ea47c97a..9a05a3d54a 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -194,7 +194,6 @@ jobs: # repeating builds to workaround segfaults in windows and ghc-8.8.4 # This build agenda in not to have successful code, -<<<<<<< HEAD # but to cache what can be cached, so step is fault tolerant & would always succseed. # 2021-12-11: NOTE: Building all targets, since # current Cabal does not allow `all --enable-tests --enable-benchmarks --only-dependencies` @@ -202,36 +201,3 @@ jobs: name: Build all targets; try 3 times run: | cabal $cabalBuild || cabal $cabalBuild || cabal $cabalBuild -||||||| b3542020 - # but to cache what can be cached, so step is fault tolerant & would always succseed. - # 2021-12-11: NOTE: Building all targets, since - # current Cabal does not allow `all --enable-tests --enable-benchmarks --only-dependencies` - - if: steps.compiled-deps.outputs.cache-hit != 'true' - name: Build all targets; try 3 times - continue-on-error: true - run: | - cabal $cabalBuild || cabal $cabalBuild || cabal $cabalBuild - - # Despite the `continue-on-error: true` directive - CI does not ignore the return code of the last step - - name: Workaround to CI platform - run: | - true -======= - # but to cache what can be cached, so step is fault tolerant & would always succeed. - # 2021-12-11: NOTE: Need to building all targets (build the project also), since - # current Cabal does not allow `all --enable-tests --enable-benchmarks --only-dependencies` combination - - - if: steps.compiled-deps.outputs.cache-hit != 'true' && runner.os == 'Linux' && matrix.ghc == '8.10.7' - name: (For Bench workflow) Build benchmark targets - continue-on-error: true - # Downloaded separately, to match the tested work/PR workflow guarantees - run: | - cabal $cabalBuild --enable-benchmarks || cabal $cabalBuild --enable-benchmarks || cabal $cabalBuild --enable-benchmarks - - - if: steps.compiled-deps.outputs.cache-hit != 'true' - name: Build targets; try 3 times - continue-on-error: true - # Done separately, matching the tested work/PR workflow guarantees - run: | - cabal $cabalBuild --enable-test || cabal $cabalBuild --enable-test || cabal $cabalBuild --enable-test ->>>>>>> master From d3f83b5260c24415399a9f5f34dadf12ca78b6a1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 28 Dec 2021 06:44:53 +0000 Subject: [PATCH 091/149] Bifunctor instance for GenLocated --- ghcide/src/Development/IDE/GHC/Orphans.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index d49affa91a..c6e60a5e67 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -33,6 +33,7 @@ import Development.IDE.GHC.Util import Control.DeepSeq import Data.Aeson +import Data.Bifunctor (Bifunctor (..)) import Data.Hashable import Data.String (IsString (fromString)) import Data.Text (Text) @@ -98,6 +99,9 @@ instance Ord FastString where instance NFData (SrcSpanAnn' a) where rnf = rwhnf + +instance Bifunctor (GenLocated) where + bimap f g (L l x) = L (f l) (g x) #endif instance NFData ParsedModule where From 63ae8dad37a64ef4a3fc7f823488b1eee68038ac Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 16:08:19 +0100 Subject: [PATCH 092/149] Build rename plugin with GHC 9.2 --- cabal-ghc921.project | 2 +- ghcide/src/Development/IDE/GHC/Compat/Parser.hs | 1 + plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs | 8 ++++++-- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index b5915008f5..7162e5fc0d 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -15,7 +15,7 @@ packages: ./plugins/hls-explicit-imports-plugin ./plugins/hls-refine-imports-plugin -- ./plugins/hls-hlint-plugin - -- ./plugins/hls-rename-plugin + ./plugins/hls-rename-plugin -- ./plugins/hls-retrie-plugin -- ./plugins/hls-haddock-comments-plugin -- ./plugins/hls-splice-plugin diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index e842053070..0e3e6e5072 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -134,6 +134,7 @@ pattern ParsedModule , pm_parsed_source = parsed , pm_extra_src_files = extra_src_files } +{-# COMPLETE ParsedModule :: GHC.ParsedModule #-} #endif mkApiAnns :: PState -> ApiAnns diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 54470fc0d8..5ffc7cfde7 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -67,15 +67,19 @@ getSrcEdits :: getSrcEdits state updateMod uri = do ccs <- lift getClientCapabilities nfp <- safeUriToNfp uri - ParsedModule{pm_parsed_source = ps, pm_annotations = apiAnns} <- + ~ParsedModule{pm_parsed_source = ps, pm_annotations = apiAnns} <- handleMaybeM "Error: could not get parsed source" $ liftIO $ runAction "Rename.GetParsedModuleWithComments" state (use GetParsedModuleWithComments nfp) - +#if !MIN_VERSION_ghc(9,2,1) let anns = relativiseApiAnns ps apiAnns src = T.pack $ exactPrint ps anns res = T.pack $ exactPrint (updateMod <$> ps) anns +#else + let src = T.pack $ exactPrint ps + res = T.pack $ exactPrint (updateMod <$> ps) +#endif pure $ diffText ccs (uri, src) res IncludeDeletions From c12de4864dcfb4d2c4a6df5c0abaabebb7258415 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 29 Dec 2021 15:19:56 +0000 Subject: [PATCH 093/149] Helpers for tracing ExactPrint ASTs --- ghcide/ghcide.cabal | 1 + ghcide/src/Development/IDE/GHC/Dump.hs | 332 ++++++++++++++++++ ghcide/src/Development/IDE/GHC/Util.hs | 47 ++- .../IDE/Plugin/CodeAction/ExactPrint.hs | 4 +- 4 files changed, 379 insertions(+), 5 deletions(-) create mode 100644 ghcide/src/Development/IDE/GHC/Dump.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index aa77adb9b5..1392f5bdb2 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -172,6 +172,7 @@ library Development.IDE.GHC.Compat.Units Development.IDE.GHC.Compat.Util Development.IDE.Core.Compile + Development.IDE.GHC.Dump Development.IDE.GHC.Error Development.IDE.GHC.ExactPrint Development.IDE.GHC.Orphans diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/ghcide/src/Development/IDE/GHC/Dump.hs new file mode 100644 index 0000000000..ddcfc87757 --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Dump.hs @@ -0,0 +1,332 @@ +{-# LANGUAGE CPP #-} +module Development.IDE.GHC.Dump(showAstDataHtml) where +import Data.Data hiding (Fixity) +import Development.IDE.GHC.Compat hiding (NameAnn) +import GHC.Hs.Dump +import Prelude hiding ((<>)) +#if MIN_VERSION_ghc(9,2,1) +import qualified Data.ByteString as B +import Development.IDE.GHC.Compat.Util (Bag, bagToList) +import GHC.Hs +import GHC.Plugins +import Generics.SYB (ext1Q, ext2Q, extQ) +import Language.Haskell.GHC.ExactPrint (ExactPrint, exactPrint) +#else +import GhcPlugins +#endif + +-- | Show a GHC syntax tree in HTML. +#if MIN_VERSION_ghc(9,2,1) +showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc +#else +showAstDataHtml :: (Data a, Outputable a) => a -> SDoc +#endif +showAstDataHtml a0 = html $ + header $$ + body (tag' [("id",text (show "myUL"))] "ul" $ vcat + [ +#if MIN_VERSION_ghc(9,2,1) + li (pre $ text (exactPrint a0)), + li (showAstDataHtml' a0), + li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0) +#else + li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan a0) +#endif + ]) + where + tag = tag' [] + tag' attrs t cont = + angleBrackets (text t <+> hcat [text a<>char '=' <>v | (a,v) <- attrs]) + <> cont + <> angleBrackets (char '/' <> text t) + ul = tag' [("class", text (show "nested"))] "ul" + li = tag "li" + caret x = tag' [("class", text "caret")] "span" "" <+> x + nested foo cts +#if MIN_VERSION_ghc(9,2,1) + | cts == empty = foo +#endif + | otherwise = foo $$ (caret $ ul cts) + body cts = tag "body" $ cts $$ tag "script" (text js) + header = tag "head" $ tag "style" $ text css + html = tag "html" + pre = tag "pre" +#if MIN_VERSION_ghc(9,2,1) + showAstDataHtml' :: Data a => a -> SDoc + showAstDataHtml' = + (generic + `ext1Q` list + `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan + `extQ` annotation + `extQ` annotationModule + `extQ` annotationAddEpAnn + `extQ` annotationGrhsAnn + `extQ` annotationEpAnnHsCase + `extQ` annotationEpAnnHsLet + `extQ` annotationAnnList + `extQ` annotationEpAnnImportDecl + `extQ` annotationAnnParen + `extQ` annotationTrailingAnn + `extQ` annotationEpaLocation + `extQ` addEpAnn + `extQ` lit `extQ` litr `extQ` litt + `extQ` sourceText + `extQ` deltaPos + `extQ` epaAnchor + `extQ` anchorOp + `extQ` bytestring + `extQ` name `extQ` occName `extQ` moduleName `extQ` var + `extQ` dataCon + `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet + `extQ` fixity + `ext2Q` located + `extQ` srcSpanAnnA + `extQ` srcSpanAnnL + `extQ` srcSpanAnnP + `extQ` srcSpanAnnC + `extQ` srcSpanAnnN + ) + + where generic :: Data a => a -> SDoc + generic t = nested (text $ showConstr (toConstr t)) + (vcat (gmapQ (li . showAstDataHtml') t)) + + string :: String -> SDoc + string = text . normalize_newlines . show + + fastString :: FastString -> SDoc + fastString s = braces $ + text "FastString:" + <+> text (normalize_newlines . show $ s) + + bytestring :: B.ByteString -> SDoc + bytestring = text . normalize_newlines . show + + list [] = brackets empty + list [x] = "[]" $$ showAstDataHtml' x + list xs = nested "[]" (vcat $ map (li . showAstDataHtml') xs) + + -- Eliminate word-size dependence + lit :: HsLit GhcPs -> SDoc + lit (HsWordPrim s x) = numericLit "HsWord{64}Prim" x s + lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s + lit (HsIntPrim s x) = numericLit "HsInt{64}Prim" x s + lit (HsInt64Prim s x) = numericLit "HsInt{64}Prim" x s + lit l = generic l + + litr :: HsLit GhcRn -> SDoc + litr (HsWordPrim s x) = numericLit "HsWord{64}Prim" x s + litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s + litr (HsIntPrim s x) = numericLit "HsInt{64}Prim" x s + litr (HsInt64Prim s x) = numericLit "HsInt{64}Prim" x s + litr l = generic l + + litt :: HsLit GhcTc -> SDoc + litt (HsWordPrim s x) = numericLit "HsWord{64}Prim" x s + litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s + litt (HsIntPrim s x) = numericLit "HsInt{64}Prim" x s + litt (HsInt64Prim s x) = numericLit "HsInt{64}Prim" x s + litt l = generic l + + numericLit :: String -> Integer -> SourceText -> SDoc + numericLit tag x s = braces $ hsep [ text tag + , generic x + , generic s ] + + sourceText :: SourceText -> SDoc + sourceText NoSourceText = text "NoSourceText" + sourceText (SourceText src) = text "SourceText" <+> text src + + epaAnchor :: EpaLocation -> SDoc + epaAnchor (EpaSpan r) = text "EpaSpan" <+> realSrcSpan r + epaAnchor (EpaDelta d cs) = text "EpaDelta" <+> deltaPos d <+> showAstDataHtml' cs + + anchorOp :: AnchorOperation -> SDoc + anchorOp UnchangedAnchor = "UnchangedAnchor" + anchorOp (MovedAnchor dp) = "MovedAnchor " <> deltaPos dp + + deltaPos :: DeltaPos -> SDoc + deltaPos (SameLine c) = text "SameLine" <+> ppr c + deltaPos (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c + + name :: Name -> SDoc + name nm = braces $ text "Name:" <+> ppr nm + + occName n = braces $ + text "OccName:" + <+> text (occNameString n) + + moduleName :: ModuleName -> SDoc + moduleName m = braces $ text "ModuleName:" <+> ppr m + + srcSpan :: SrcSpan -> SDoc + srcSpan ss = char ' ' <> + (hang (ppr ss) 1 + -- TODO: show annotations here + (text "")) + + realSrcSpan :: RealSrcSpan -> SDoc + realSrcSpan ss = braces $ char ' ' <> + (hang (ppr ss) 1 + -- TODO: show annotations here + (text "")) + + addEpAnn :: AddEpAnn -> SDoc + addEpAnn (AddEpAnn a s) = text "AddEpAnn" <+> ppr a <+> epaAnchor s + + var :: Var -> SDoc + var v = braces $ text "Var:" <+> ppr v + + dataCon :: DataCon -> SDoc + dataCon c = braces $ text "DataCon:" <+> ppr c + + bagRdrName:: Bag (LocatedA (HsBind GhcPs)) -> SDoc + bagRdrName bg = braces $ + text "Bag(LocatedA (HsBind GhcPs)):" + $$ (list . bagToList $ bg) + + bagName :: Bag (LocatedA (HsBind GhcRn)) -> SDoc + bagName bg = braces $ + text "Bag(LocatedA (HsBind Name)):" + $$ (list . bagToList $ bg) + + bagVar :: Bag (LocatedA (HsBind GhcTc)) -> SDoc + bagVar bg = braces $ + text "Bag(LocatedA (HsBind Var)):" + $$ (list . bagToList $ bg) + + nameSet ns = braces $ + text "NameSet:" + $$ (list . nameSetElemsStable $ ns) + + fixity :: Fixity -> SDoc + fixity fx = braces $ + text "Fixity:" + <+> ppr fx + + located :: (Data a, Data b) => GenLocated a b -> SDoc + located (L ss a) + = nested "L" $ (li (showAstDataHtml' ss) $$ li (showAstDataHtml' a)) + + -- ------------------------- + + annotation :: EpAnn [AddEpAnn] -> SDoc + annotation = annotation' (text "EpAnn [AddEpAnn]") + + annotationModule :: EpAnn AnnsModule -> SDoc + annotationModule = annotation' (text "EpAnn AnnsModule") + + annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc + annotationAddEpAnn = annotation' (text "EpAnn AddEpAnn") + + annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc + annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn") + + annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc + annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase") + + annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc + annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet") + + annotationAnnList :: EpAnn AnnList -> SDoc + annotationAnnList = annotation' (text "EpAnn AnnList") + + annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc + annotationEpAnnImportDecl = annotation' (text "EpAnn EpAnnImportDecl") + + annotationAnnParen :: EpAnn AnnParen -> SDoc + annotationAnnParen = annotation' (text "EpAnn AnnParen") + + annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc + annotationTrailingAnn = annotation' (text "EpAnn TrailingAnn") + + annotationEpaLocation :: EpAnn EpaLocation -> SDoc + annotationEpaLocation = annotation' (text "EpAnn EpaLocation") + + annotation' :: forall a .(Data a, Typeable a) + => SDoc -> EpAnn a -> SDoc + annotation' tag anns = nested (text $ showConstr (toConstr anns)) + (vcat (map li $ gmapQ showAstDataHtml' anns)) + + -- ------------------------- + + srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc + srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA") + + srcSpanAnnL :: SrcSpanAnn' (EpAnn AnnList) -> SDoc + srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL") + + srcSpanAnnP :: SrcSpanAnn' (EpAnn AnnPragma) -> SDoc + srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP") + + srcSpanAnnC :: SrcSpanAnn' (EpAnn AnnContext) -> SDoc + srcSpanAnnC = locatedAnn'' (text "SrcSpanAnnC") + + srcSpanAnnN :: SrcSpanAnn' (EpAnn NameAnn) -> SDoc + srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN") + + locatedAnn'' :: forall a. (Typeable a, Data a) + => SDoc -> SrcSpanAnn' a -> SDoc + locatedAnn'' tag ss = + case cast ss of + Just ((SrcSpanAnn ann s) :: SrcSpanAnn' a) -> + nested "SrcSpanAnn" $ ( + li(showAstDataHtml' ann) + $$ li(srcSpan s)) + Nothing -> text "locatedAnn:unmatched" <+> tag + <+> (text (showConstr (toConstr ss))) +#endif + + +normalize_newlines :: String -> String +normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs +normalize_newlines (x:xs) = x:normalize_newlines xs +normalize_newlines [] = [] + +css :: String +css = unlines + [ "body {background-color: black; color: white ;}" + , "/* Remove default bullets */" + , "ul, #myUL {" + , " list-style-type: none;" + , "}" + , "/* Remove margins and padding from the parent ul */" + , "#myUL {" + , " margin: 0; " + , " padding: 0; " + , "} " + , "/* Style the caret/arrow */ " + , ".caret { " + , " cursor: pointer; " + , " user-select: none; /* Prevent text selection */" + , "} " + , "/* Create the caret/arrow with a unicode, and style it */" + , ".caret::before { " + , " content: \"\\25B6 \"; " + , " color: white; " + , " display: inline-block; " + , " margin-right: 6px; " + , "} " + , "/* Rotate the caret/arrow icon when clicked on (using JavaScript) */" + , ".caret-down::before { " + , " transform: rotate(90deg); " + , "} " + , "/* Hide the nested list */ " + , ".nested { " + , " display: none; " + , "} " + , "/* Show the nested list when the user clicks on the caret/arrow (with JavaScript) */" + , ".active { " + , " display: block;}" + ] + +js :: String +js = unlines + [ "var toggler = document.getElementsByClassName(\"caret\");" + , "var i;" + , "for (i = 0; i < toggler.length; i++) {" + , " toggler[i].addEventListener(\"click\", function() {" + , " this.parentElement.querySelector(\".nested\").classList.toggle(\"active\");" + , " this.classList.toggle(\"caret-down\");" + , " }); }" + ] diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 1e3568086b..1ed87e86d3 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -28,7 +28,7 @@ module Development.IDE.GHC.Util( setHieDir, dontWriteHieFiles, disableWarningsAsErrors, - ) where + tracePpr) where #if MIN_VERSION_ghc(9,2,0) import GHC @@ -79,30 +79,38 @@ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy as LBS +import Data.Data (Data) import Data.IORef import Data.List.Extra import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T +import Data.Time.Clock.POSIX (POSIXTime, getCurrentTime, + utcTimeToPOSIXSeconds) import Data.Typeable +import qualified Data.Unique as U +import Debug.Trace import Development.IDE.GHC.Compat as GHC import qualified Development.IDE.GHC.Compat.Parser as Compat import qualified Development.IDE.GHC.Compat.Units as Compat -import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Dump (showAstDataHtml) import Development.IDE.Types.Location import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable -import GHC import GHC.IO.BufferedIO (BufferedIO) import GHC.IO.Device as IODevice import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals import GHC.IO.Handle.Types - +import GHC.Stack +import Language.Haskell.GHC.ExactPrint (ExactPrint, exactPrint) +import System.Environment.Blank (getEnvDefault) import System.FilePath +import System.IO.Unsafe +import Text.Printf ---------------------------------------------------------------------- @@ -300,3 +308,34 @@ ioe_dupHandlesNotCompatible :: Handle -> IO a ioe_dupHandlesNotCompatible h = ioException (IOError (Just h) IllegalOperation "hDuplicateTo" "handles are incompatible" Nothing Nothing) + +-------------------------------------------------------------------------------- +-- Tracing exactprint terms + +{-# NOINLINE timestamp #-} +timestamp :: POSIXTime +timestamp = utcTimeToPOSIXSeconds $ unsafePerformIO getCurrentTime + +debugAST :: Bool +debugAST = unsafePerformIO (getEnvDefault "GHCIDE_DEBUG_AST" "0") == "1" + +-- | Prints an 'Outputable' value to stderr and to an HTML file for further inspection +traceAst :: (Data a, ExactPrint a, Outputable a, HasCallStack) => String -> a -> a +traceAst lbl x + | debugAST = trace doTrace x + | otherwise = x + where + renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True} + -- plainDump = showAstData NoBlankSrcSpan NoBlankEpAnnotations x + htmlDump = showAstDataHtml x + doTrace = unsafePerformIO $ do + u <- U.newUnique + let htmlDumpFileName = printf "/tmp/hls/%s-%s-%d.html" (show timestamp) lbl (U.hashUnique u) + writeFile htmlDumpFileName $ renderDump htmlDump + return $ unlines + [prettyCallStack callStack ++ ":" + , exactPrint x + -- , renderDump plainDump + , "file://" ++ htmlDumpFileName] + + diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index aa89746c09..ea44950ed1 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -58,7 +58,7 @@ data Rewrite where #if !MIN_VERSION_ghc(9,2,0) Annotate ast => #else - ExactPrint (GenLocated (Anno ast) ast) => + (ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast), Outputable (GenLocated (Anno ast) ast), Data (GenLocated (Anno ast) ast)) => #endif -- | The 'SrcSpan' that we want to rewrite SrcSpan -> @@ -135,6 +135,8 @@ rewriteToWEdit dflags uri -- | Fix the parentheses around a type context fixParens :: (Monad m, Data (HsType pass), pass ~ GhcPass p0) => + + (ExactPrint (HsType pass), Outputable (LHsType pass)) => #if !MIN_VERSION_ghc(9,2,0) Maybe DeltaPos -> Maybe DeltaPos -> From 552cfc54c37f376f7f644e9c93a71898796b2d1f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 09:54:55 +0100 Subject: [PATCH 094/149] Fix exactprint code actions --- ghcide/ghcide.cabal | 1 + ghcide/src/Development/IDE/GHC/Compat.hs | 2 + ghcide/src/Development/IDE/GHC/Compat/Core.hs | 10 +- .../Development/IDE/GHC/Compat/ExactPrint.hs | 23 +++ ghcide/src/Development/IDE/GHC/ExactPrint.hs | 69 ++++++-- ghcide/src/Development/IDE/GHC/Orphans.hs | 5 + ghcide/src/Development/IDE/GHC/Util.hs | 40 ++--- .../src/Development/IDE/Plugin/CodeAction.hs | 42 ++--- .../Development/IDE/Plugin/CodeAction/Args.hs | 4 +- .../IDE/Plugin/CodeAction/ExactPrint.hs | 154 +++++++++++------- .../src/Development/IDE/Plugin/Completions.hs | 6 +- .../IDE/Plugin/Completions/Logic.hs | 33 ++-- ghcide/test/exe/Main.hs | 14 +- 13 files changed, 256 insertions(+), 147 deletions(-) create mode 100644 ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 1392f5bdb2..826bf9b1bf 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -164,6 +164,7 @@ library Development.IDE.GHC.Compat Development.IDE.GHC.Compat.Core Development.IDE.GHC.Compat.Env + Development.IDE.GHC.Compat.ExactPrint Development.IDE.GHC.Compat.Iface Development.IDE.GHC.Compat.Logger Development.IDE.GHC.Compat.Outputable diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index a0779964a8..b1adb9b3d9 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -53,6 +53,7 @@ module Development.IDE.GHC.Compat( -- * Compat modules module Development.IDE.GHC.Compat.Core, module Development.IDE.GHC.Compat.Env, + module Development.IDE.GHC.Compat.ExactPrint, module Development.IDE.GHC.Compat.Iface, module Development.IDE.GHC.Compat.Logger, module Development.IDE.GHC.Compat.Outputable, @@ -70,6 +71,7 @@ import GHC hiding (HasSrcSpan, ModLocation, getLoc, lookupName, RealSrcSpan) import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.ExactPrint import Development.IDE.GHC.Compat.Iface import Development.IDE.GHC.Compat.Logger import Development.IDE.GHC.Compat.Outputable diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index bc0e45b192..1d1797d602 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -194,7 +194,11 @@ module Development.IDE.GHC.Compat.Core ( getLocA, locA, LocatedAn, +#if MIN_VERSION_ghc(9,2,0) + GHC.AnnListItem(..), +#else AnnListItem, +#endif NameAnn, SrcLoc.RealLocated, SrcLoc.GenLocated(..), @@ -814,7 +818,7 @@ instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where instance HasSrcSpan (SrcSpanAnn' ann) where getLoc = locA instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where - getLoc = getLoc . getLoc + getLoc (L l _) = l pattern L l a <- GHC.L (getLoc -> l) a #endif @@ -1011,9 +1015,7 @@ getLocA = GHC.getLocA getLocA x = GHC.getLoc x #endif -#if MIN_VERSION_ghc(9,2,0) -type AnnListItem = GHC.AnnListItem -#else +#if !MIN_VERSION_ghc(9,2,0) type AnnListItem = SrcLoc.SrcSpan #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs new file mode 100644 index 0000000000..1b085f5192 --- /dev/null +++ b/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} + +module Development.IDE.GHC.Compat.ExactPrint + ( ExactPrint + , exactPrint + , makeDeltaAst +#if !MIN_VERSION_ghc(9,2,0) + , Annotated(..) +#endif + ) where + +import Language.Haskell.GHC.ExactPrint +import Retrie.ExactPrint (Annotated (..)) + +#if !MIN_VERSION_ghc(9,2,0) +class ExactPrint ast where + makeDeltaAst :: ast -> ast + makeDeltaAst = id + +instance ExactPrint ast +#endif + diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 49eebe704f..4382ed645e 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} @@ -20,8 +21,20 @@ module Development.IDE.GHC.ExactPrint graftSmallestDeclsWithM, transform, transformM, + ExactPrint(..), #if !MIN_VERSION_ghc(9,2,0) useAnnotatedSource, + Anns, + Annotate, + setPrecedingLinesT, +#else + addParensToCtxt, + modifyAnns, + removeComma, + -- * Helper function + eqSrcSpan, + epl, + epAnn, #endif annotateParsedSource, getAnnotatedParsedSourceRule, @@ -30,24 +43,18 @@ module Development.IDE.GHC.ExactPrint ExceptStringT (..), Annotated(..), TransformT, -#if !MIN_VERSION_ghc(9,2,0) - Anns, - Annotate, - setPrecedingLinesT, -#endif - -- * Helper function - eqSrcSpan, ) where import Control.Applicative (Alternative) -import Control.Arrow +import Control.Arrow ((***)) import Control.Monad import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class import Control.Monad.Trans.Except import Control.Monad.Zip +import Data.Bifunctor import Data.Bool (bool) import qualified Data.DList as DL import Data.Either.Extra (mapLeft) @@ -70,7 +77,6 @@ import qualified GHC.Generics as GHC import Generics.SYB import Generics.SYB.GHC import Ide.PluginUtils -import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers import Language.LSP.Types import Language.LSP.Types.Capabilities (ClientCapabilities) @@ -78,7 +84,17 @@ import Retrie.ExactPrint hiding (parseDecl, parseExpr, parsePattern, parseType) - +#if MIN_VERSION_ghc(9,2,0) +import GHC (EpAnn (..), + SrcSpanAnn' (SrcSpanAnn), + SrcSpanAnnA, + TrailingAnn (AddCommaAnn), + emptyComments, + spanAsAnchor) +import GHC.Parser.Annotation (AnnContext (..), + DeltaPos (SameLine), + EpaLocation (EpaDelta)) +#endif ------------------------------------------------------------------------------ @@ -101,7 +117,8 @@ getAnnotatedParsedSourceRule = define $ \GetAnnotatedParsedSource nfp -> do #if MIN_VERSION_ghc(9,2,0) annotateParsedSource :: ParsedModule -> ParsedSource -annotateParsedSource (ParsedModule _ ps _ _) = ps +annotateParsedSource (ParsedModule _ ps _ _) = makeDeltaAst ps + #else annotateParsedSource :: ParsedModule -> Annotated ParsedSource annotateParsedSource = fixAnns @@ -602,3 +619,33 @@ eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool eqSrcSpanA l r = leftmost_smallest l r == EQ #endif + +#if MIN_VERSION_ghc(9,2,0) +addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext +addParensToCtxt close_dp = addOpen . addClose + where + addOpen it@AnnContext{ac_open = []} = it{ac_open = [epl 0]} + addOpen other = other + addClose it + | Just c <- close_dp = it{ac_close = [c]} + | AnnContext{ac_close = []} <- it = it{ac_close = [epl 0]} + | otherwise = it + +epl :: Int -> EpaLocation +epl n = EpaDelta (SameLine n) [] + +epAnn :: SrcSpan -> ann -> EpAnn ann +epAnn srcSpan anns = EpAnn (spanAsAnchor srcSpan) anns emptyComments + +modifyAnns :: LocatedAn a ast -> (a -> a) -> LocatedAn a ast +modifyAnns x f = first ((fmap.fmap) f) x + +removeComma :: SrcSpanAnnA -> SrcSpanAnnA +removeComma it@(SrcSpanAnn EpAnnNotUsed _) = it +removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l) + = (SrcSpanAnn (EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs) l) + where + isCommaAnn AddCommaAnn{} = True + isCommaAnn _ = False + +#endif diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index c6e60a5e67..6f32546a4a 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -9,6 +9,9 @@ -- Note that the 'NFData' instances may not be law abiding. module Development.IDE.GHC.Orphans() where +#if MIN_VERSION_ghc(9,2,0) +import GHC.Parser.Annotation +#endif #if MIN_VERSION_ghc(9,0,0) import GHC.Data.Bag import GHC.Data.FastString @@ -102,6 +105,8 @@ instance NFData (SrcSpanAnn' a) where instance Bifunctor (GenLocated) where bimap f g (L l x) = L (f l) (g x) + +deriving instance Functor SrcSpanAnn' #endif instance NFData ParsedModule where diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 1ed87e86d3..4e002b13ec 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -28,49 +28,25 @@ module Development.IDE.GHC.Util( setHieDir, dontWriteHieFiles, disableWarningsAsErrors, - tracePpr) where + traceAst) where #if MIN_VERSION_ghc(9,2,0) -import GHC -import GHC.Core.Multiplicity -import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Data.FastString import GHC.Data.StringBuffer import GHC.Driver.Env -import GHC.Driver.Env.Types import GHC.Driver.Monad import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags -import GHC.Hs.Extension -import qualified GHC.Hs.Type as GHC -import GHC.Iface.Env (updNameCache) -import GHC.Iface.Make (mkIfaceExports) -import qualified GHC.Linker.Types as LinkerTypes import GHC.Parser.Lexer import GHC.Runtime.Context -import GHC.Tc.Types (TcGblEnv (tcg_exports)) -import GHC.Tc.Utils.TcType (pprSigmaType) -import GHC.Types.Avail -import GHC.Types.Name.Cache import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader import GHC.Types.SrcLoc -import qualified GHC.Types.SrcLoc as SrcLoc -import GHC.Unit.Env -import GHC.Unit.Info (PackageName) -import qualified GHC.Unit.Info as Packages -import qualified GHC.Unit.Module.Location as Module import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (mi_mod_hash) -import GHC.Unit.Module.Name (moduleNameSlashes) -import qualified GHC.Unit.State as Packages -import GHC.Unit.Types (IsBootInterface (..), - unitString) -import qualified GHC.Unit.Types as Module import GHC.Utils.Fingerprint import GHC.Utils.Outputable -import qualified GHC.Utils.Outputable as Outputable +#else +import Development.IDE.GHC.Compat.Util #endif import Control.Concurrent import Control.Exception as E @@ -99,6 +75,7 @@ import Development.IDE.Types.Location import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable +import GHC import GHC.IO.BufferedIO (BufferedIO) import GHC.IO.Device as IODevice import GHC.IO.Encoding @@ -106,7 +83,6 @@ import GHC.IO.Exception import GHC.IO.Handle.Internals import GHC.IO.Handle.Types import GHC.Stack -import Language.Haskell.GHC.ExactPrint (ExactPrint, exactPrint) import System.Environment.Blank (getEnvDefault) import System.FilePath import System.IO.Unsafe @@ -325,8 +301,11 @@ traceAst lbl x | debugAST = trace doTrace x | otherwise = x where +#if MIN_VERSION_ghc(9,2,0) renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True} - -- plainDump = showAstData NoBlankSrcSpan NoBlankEpAnnotations x +#else + renderDump = unsafePrintSDoc +#endif htmlDump = showAstDataHtml x doTrace = unsafePerformIO $ do u <- U.newUnique @@ -334,8 +313,9 @@ traceAst lbl x writeFile htmlDumpFileName $ renderDump htmlDump return $ unlines [prettyCallStack callStack ++ ":" +#if MIN_VERSION_ghc(9,2,0) , exactPrint x - -- , renderDump plainDump +#endif , "file://" ++ htmlDumpFileName] diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 5369239dc8..d2dbaf4361 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -23,7 +23,7 @@ import Control.Applicative ((<|>)) import Control.Arrow (second, (>>>)) import Control.Concurrent.STM.Stats (atomically) -import Control.Monad (guard, join) +import Control.Monad (guard, join, msum) import Control.Monad.IO.Class import Data.Char import qualified Data.DList as DL @@ -48,7 +48,7 @@ import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util (prettyPrint, printRdrName, - unsafePrintSDoc) + unsafePrintSDoc, traceAst) import Development.IDE.Plugin.CodeAction.Args import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.CodeAction.PositionIndexed @@ -79,6 +79,7 @@ import Language.LSP.Types (CodeAction ( import Language.LSP.VFS import Text.Regex.TDFA (mrAfter, (=~), (=~~)) +import Development.IDE.GHC.ExactPrint ------------------------------------------------------------------------------------------------- @@ -150,12 +151,12 @@ findSigOfDecl pred decls = any (pred . unLoc) idsSig ] -findSigOfDeclRanged :: p ~ GhcPass p0 => Range -> [LHsDecl p] -> Maybe (Sig p) +findSigOfDeclRanged :: Range -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs) findSigOfDeclRanged range decls = do dec <- findDeclContainingLoc (_start range) decls case dec of L _ (SigD _ sig@TypeSig {}) -> Just sig - L _ (ValD _ (bind :: HsBind p)) -> findSigOfBind range bind + L _ (ValD _ (bind :: HsBind p)) -> findSigOfBind range (traceAst "bind" bind) _ -> Nothing findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p) @@ -167,27 +168,25 @@ findSigOfBind range bind = findSigOfLMatch :: [LMatch p (LHsExpr p)] -> Maybe (Sig p) findSigOfLMatch ls = do match <- findDeclContainingLoc (_start range) ls - let rhs = m_grhss $ unLoc match -#if !MIN_VERSION_ghc(9,2,0) - span = getLoc $ reLoc $ grhssLocalBinds rhs -#else - span = getLoc $ reLoc $ match -#endif - findSigOfGRHSs span rhs - - findSigOfGRHSs :: SrcSpan -> GRHSs p (LHsExpr p) -> Maybe (Sig p) - findSigOfGRHSs span grhs = do - if _start range `isInsideSrcSpan` span + let grhs = m_grhss $ unLoc match #if !MIN_VERSION_ghc(9,2,0) + span = getLoc $ reLoc $ grhssLocalBinds grhs + if _start range `isInsideSrcSpan` span then findSigOfBinds range (unLoc (grhssLocalBinds grhs)) -- where clause -#else - then findSigOfBinds range (grhssLocalBinds grhs) -- where clause -#endif else do grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs) case unLoc grhs of GRHS _ _ bd -> findSigOfExpr (unLoc bd) _ -> Nothing +#else + msum + [findSigOfBinds range (grhssLocalBinds grhs) -- where clause + , do + grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs) + case unLoc grhs of + GRHS _ _ bd -> findSigOfExpr (unLoc bd) + ] +#endif findSigOfExpr :: HsExpr p -> Maybe (Sig p) findSigOfExpr = go @@ -223,9 +222,9 @@ findInstanceHead df instanceHead decls = showSDoc df (ppr hsib_body) == instanceHead ] +-- findDeclContainingLoc :: Position -> [GenLocated (SrcSpanAnn' a) e] -> Maybe (GenLocated (SrcSpanAnn' a) e) findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) - -- Single: -- This binding for ‘mod’ shadows the existing binding -- imported from ‘Prelude’ at haskell-language-server/ghcide/src/Development/IDE/Plugin/CodeAction.hs:10:8-40 @@ -1061,9 +1060,10 @@ suggestFixConstructorImport Diagnostic{_range=_range,..} = let fixedImport = typ <> "(" <> constructor <> ")" in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)] | otherwise = [] + -- | Suggests a constraint for a declaration for which a constraint is missing. suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] -suggestConstraint df parsedModule diag@Diagnostic {..} +suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} | Just missingConstraint <- findMissingConstraint _message = let codeAction = if _message =~ ("the type signature for:" :: String) then suggestFunctionConstraint df parsedModule @@ -1204,7 +1204,7 @@ removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..} #else , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})}) #endif - <- findSigOfDeclRanged _range hsmodDecls + <- fmap(traceAst "redundantConstraint") $ findSigOfDeclRanged _range hsmodDecls , Just redundantConstraintList <- findRedundantConstraints _message , rewrite <- removeConstraint (toRemove df redundantConstraintList) sig = [(actionTitle redundantConstraintList typeSignatureName, rewrite)] diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index 408dd89c44..14abdce685 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE CPP #-} module Development.IDE.Plugin.CodeAction.Args ( CodeActionTitle, @@ -216,6 +216,7 @@ toCodeAction2 get f = ReaderT $ \caa -> toCodeAction3 :: (ToCodeAction r) => (CodeActionArgs -> IO a) -> (a -> r) -> GhcideCodeAction toCodeAction3 get f = ReaderT $ \caa -> get caa >>= flip runReaderT caa . toCodeAction . f +-- | this instance returns a delta AST, useful for exactprint transforms instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} -> x >>= \case @@ -260,6 +261,7 @@ instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) wh instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where toCodeAction = toCodeAction2 caaAnnSource #else +-- | this instance returns a delta AST, useful for exactprint transforms instance ToCodeAction r => ToCodeAction (Maybe ParsedSource -> r) where toCodeAction = toCodeAction1 caaAnnSource #endif diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index ea44950ed1..f418070d24 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -3,6 +3,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module Development.IDE.Plugin.CodeAction.ExactPrint ( Rewrite (..), @@ -33,21 +35,30 @@ import Data.Maybe (fromJust, isNothing, mapMaybe) import qualified Data.Text as T import Development.IDE.GHC.Compat -import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Error -import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), -#if !MIN_VERSION_ghc(9,2,0) - Annotate -#endif - ) +import Development.IDE.GHC.ExactPrint import Development.IDE.Spans.Common import GHC.Exts (IsList (fromList)) import Language.Haskell.GHC.ExactPrint #if !MIN_VERSION_ghc(9,2,0) +import qualified Development.IDE.GHC.Compat.Util as Util import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey) +#else +import Data.Default +import GHC (AddEpAnn (..), AnnContext (..), AnnParen (..), + DeltaPos (SameLine), EpAnn (..), EpaLocation (EpaDelta), + IsUnicodeSyntax (NormalSyntax), + NameAdornment (NameParens), NameAnn (..), + SrcSpanAnn' (SrcSpanAnn), SrcSpanAnnA, + TrailingAnn (AddCommaAnn), addAnns, ann, emptyComments, + reAnnL) #endif import Language.LSP.Types +import Development.IDE.GHC.Util +import Data.Bifunctor (first) +import Control.Lens (_last, over) +import GHC.Stack (HasCallStack) ------------------------------------------------------------------------------ @@ -71,9 +82,18 @@ data Rewrite where Rewrite ------------------------------------------------------------------------------ +#if MIN_VERSION_ghc(9,2,0) +class ResetEntryDP ann where + resetEntryDP :: GenLocated ann ast -> GenLocated ann ast +instance {-# OVERLAPPING #-} Default an => ResetEntryDP (SrcAnn an) where + -- resetEntryDP = flip setEntryDP (SameLine 0) + resetEntryDP (L srcAnn x) = setEntryDP (L srcAnn{ann=EpAnnNotUsed} x) (SameLine 0) +instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where + resetEntryDP = id +#endif -- | Convert a 'Rewrite' into a list of '[TextEdit]'. -rewriteToEdit :: +rewriteToEdit :: HasCallStack => DynFlags -> #if !MIN_VERSION_ghc(9,2,0) Anns -> @@ -94,7 +114,7 @@ rewriteToEdit dflags #if !MIN_VERSION_ghc(9,2,0) ast <$ setEntryDPT ast (DP (0, 0)) #else - pure ast + pure $ traceAst "REWRITE_result" $ resetEntryDP ast #endif let editMap = [ TextEdit (fromJust $ srcSpanToRange dst) $ @@ -132,25 +152,19 @@ rewriteToWEdit dflags uri ------------------------------------------------------------------------------ +#if !MIN_VERSION_ghc(9,2,0) -- | Fix the parentheses around a type context fixParens :: (Monad m, Data (HsType pass), pass ~ GhcPass p0) => - - (ExactPrint (HsType pass), Outputable (LHsType pass)) => -#if !MIN_VERSION_ghc(9,2,0) Maybe DeltaPos -> Maybe DeltaPos -> -#endif LHsContext pass -> TransformT m [LHsType pass] fixParens -#if !MIN_VERSION_ghc(9,2,0) openDP closeDP -#endif ctxt@(L _ elems) = do -- Paren annotation for type contexts are usually quite screwed up -- we remove duplicates and fix negative DPs -#if !MIN_VERSION_ghc(9,2,0) let parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)] modifyAnnsT $ Map.adjust @@ -165,20 +179,19 @@ fixParens } ) (mkAnnKey ctxt) -#endif return $ map dropHsParTy elems - where +#endif - dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass) - dropHsParTy (L _ (HsParTy _ ty)) = ty - dropHsParTy other = other +dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass) +dropHsParTy (L _ (HsParTy _ ty)) = ty +dropHsParTy other = other removeConstraint :: -- | Predicate: Which context to drop. (LHsType GhcPs -> Bool) -> LHsType GhcPs -> Rewrite -removeConstraint toRemove = go +removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" where go :: LHsType GhcPs -> Rewrite #if !MIN_VERSION_ghc(9,2,0) @@ -186,13 +199,21 @@ removeConstraint toRemove = go #else go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do #endif - let ctxt' = L l' $ filter (not . toRemove) ctxt + let ctxt' = filter (not . toRemove) ctxt + removeStuff = (toRemove <$> headMaybe ctxt) == Just True #if !MIN_VERSION_ghc(9,2,0) - when ((toRemove <$> headMaybe ctxt) == Just True) $ + when removeStuff $ setEntryDPT hst_body (DP (0, 0)) - return $ L l $ it{hst_ctxt = ctxt'} + return $ L l $ it{hst_ctxt = L l' ctxt'} #else - return $ L l $ it{hst_ctxt = Just ctxt'} + let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body + return $ case ctxt' of + [] -> hst_body' + _ -> do + let ctxt'' = over _last (first removeComma) ctxt' + L l $ it{ hst_ctxt = Just $ L l' ctxt'' + , hst_body = hst_body' + } #endif go (L _ (HsParTy _ ty)) = go ty go (L _ HsForAllTy{hst_body}) = go hst_body @@ -206,7 +227,7 @@ appendConstraint :: -- | The type signature where the constraint is to be inserted, also assuming annotated LHsType GhcPs -> Rewrite -appendConstraint constraintT = go +appendConstraint constraintT = go . traceAst "appendConstraint" where #if !MIN_VERSION_ghc(9,2,0) go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do @@ -221,29 +242,32 @@ appendConstraint constraintT = go -- rather than to the constraint list itself, so to preserve them we need to reposition them closeParenDP <- lookupAnn (G AnnCloseP) `mapM` lastMaybe ctxt openParenDP <- lookupAnn (G AnnOpenP) `mapM` headMaybe ctxt -#endif ctxt' <- fixParens -#if !MIN_VERSION_ghc(9,2,0) (join openParenDP) (join closeParenDP) -#endif (L l' ctxt) - -#if !MIN_VERSION_ghc(9,2,0) addTrailingCommaT (last ctxt') return $ L l $ it{hst_ctxt = L l' $ ctxt' ++ [constraint]} #else - return $ L l $ it{hst_ctxt = Just $ L l' $ ctxt' ++ [constraint]} + constraint <- pure $ setEntryDP constraint (SameLine 1) + let l'' = (fmap.fmap) (addParensToCtxt close_dp) l' + -- For singleton constraints, the close Paren DP is attached to an HsPar wrapping the constraint + -- we have to reposition it manually into the AnnContext + close_dp = case ctxt of + [L _ (HsParTy EpAnn{anns=AnnParen{ap_close}} _)] -> Just ap_close + _ -> Nothing + ctxt' = over _last (first addComma) $ map dropHsParTy ctxt + return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]} #endif go (L _ HsForAllTy{hst_body}) = go hst_body go (L _ (HsParTy _ ty)) = go ty - go (L l other) = Rewrite (locA l) $ \df -> do + go ast@(L l _) = Rewrite (locA l) $ \df -> do -- there isn't a context, so we must create one constraint <- liftParseAST df constraintT lContext <- uniqueSrcSpanT lTop <- uniqueSrcSpanT #if !MIN_VERSION_ghc(9,2,0) let context = L lContext [constraint] - addSimpleAnnT context (DP (0, 0)) $ + addSimpleAnnT context dp00 $ (G AnnDarrow, DP (0, 1)) : concat [ [ (G AnnOpenP, dp00) @@ -252,24 +276,22 @@ appendConstraint constraintT = go | hsTypeNeedsParens sigPrec $ unLoc constraint ] #else - let context = Just $ reLocA $ L lContext [constraint] + let context = Just $ reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint] + annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens] + needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint + ast <- pure $ setEntryDP ast (SameLine 1) #endif - return $ reLocA $ L lTop $ HsQualTy noExtField context (L l other) + return $ reLocA $ L lTop $ HsQualTy noExtField context ast -liftParseAST :: forall ast l. (ASTElement l ast - ) - => DynFlags -> String -#if MIN_VERSION_ghc(9,2,0) - -> TransformT (Either String) (GenLocated (SrcAnn l) ast) -#else - -> TransformT (Either String) (Located ast) -#endif +liftParseAST + :: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast)) + => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast) liftParseAST df s = case parseAST df "" s of #if !MIN_VERSION_ghc(9,2,0) Right (anns, x) -> modifyAnnsT (anns <>) $> x #else - Right x -> pure x + Right x -> pure (makeDeltaAst x) #endif Left _ -> lift $ Left $ "No parse: " <> s @@ -314,7 +336,7 @@ extendImport mparent identifier lDecl@(L l _) = Just parent -> extendImportViaParent df parent identifier lDecl _ -> extendImportTopLevel identifier lDecl --- | Add an identifier or a data type to import list +-- | Add an identifier or a data type to import list. Expects a Delta AST -- -- extendImportTopLevel "foo" AST: -- @@ -332,7 +354,6 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) src <- uniqueSrcSpanT top <- uniqueSrcSpanT let rdr = reLocA $ L src $ mkRdrUnqual $ mkVarOcc thing - let alreadyImported = showNameWithoutUniques (occName (unLoc rdr)) `elem` map (showNameWithoutUniques @OccName) (listify (const True) lies) @@ -341,6 +362,7 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) let lie = reLocA $ L src $ IEName rdr x = reLocA $ L top $ IEVar noExtField lie + if x `elem` lies then lift (Left $ thing <> " already imported") else do @@ -353,8 +375,15 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) -- we need change the ann key from `[]` to `:` to keep parens and other anns. unless hasSibling $ transferAnn (L l' lies) (L l' [x]) id -#endif return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])} +#else + + x <- pure $ setEntryDP x (SameLine $ if hasSibling then 1 else 0) + + let fixLast = if hasSibling then first addComma else id + lies' = over _last fixLast lies ++ [x] + return $ L l it{ideclHiding = Just (hide, L l' lies')} +#endif extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list" -- | Add an identifier with its parent to import list @@ -392,21 +421,23 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]} addSimpleAnnT childRdr dp00 [(G AnnVal, dp00)] #else - x :: LIE GhcPs = L ll' $ IEThingWith mempty absIE NoIEWildcard [childLIE] + x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE] #endif return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} #if !MIN_VERSION_ghc(9,2,0) go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs) #else - go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies')) : xs) + go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs) #endif -- ThingWith ie lies' => ThingWith ie (lies' ++ [child]) | parent == unIEWrappedName ie - , hasSibling <- not $ null lies' = + , hasSibling <- not $ null lies' = do srcChild <- uniqueSrcSpanT let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child - +#if MIN_VERSION_ghc(9,2,0) + childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0 +#endif let alreadyImported = showNameWithoutUniques (occName (unLoc childRdr)) `elem` map (showNameWithoutUniques @OccName) (listify (const True) lies') @@ -420,7 +451,13 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)] return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)} #else - return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith mempty twIE NoIEWildcard (lies' ++ [childLIE]))] ++ xs)} + let it' = it{ideclHiding = Just (hide, lies)} + lies = L l' $ reverse pre ++ + [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs + fixLast = if hasSibling then first addComma else id + return $ if hasSibling + then L l it' + else L l it' #endif go hide l' pre (x : xs) = go hide l' (x : pre) xs go hide l' pre [] @@ -438,7 +475,10 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr) childLIE = reLocA $ L srcChild $ IEName childRdr #else - let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType mempty parentRdr else IEName parentRdr) + let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName parentRdr') + parentRdr' = modifyAnns parentRdr $ \case + it@NameAnn{nann_adornment = NameParens} -> it{nann_open = epl 1} + other -> other childLIE = reLocA $ L srcChild $ IEName childRdr #endif #if !MIN_VERSION_ghc(9,2,0) @@ -454,7 +494,8 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) unless hasSibling $ transferAnn (L l' $ reverse pre) (L l' [x]) id #else - x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith mempty parentLIE NoIEWildcard [childLIE] + x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE] + listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)] #endif return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x])} extendImportViaParent _ _ _ _ = lift $ Left "Unable to extend the import list via parent" @@ -533,11 +574,14 @@ extendHiding symbol (L l idecls) mlies df = do addTrailingCommaT (head lies) -- Why we need this? else forM_ mlies $ \lies0 -> do transferAnn lies0 singleHide id +#else +-- let l'' = flip first l $ fmap.fmap $ (AnnHiding :) #endif return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)} where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc + deleteFromImport :: String -> LImportDecl GhcPs -> diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 0aa5dc7046..f29fc94ace 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -23,9 +23,7 @@ import Development.IDE.Core.Service import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (rangeToSrcSpan) -import Development.IDE.GHC.ExactPrint (Annotated (..), - GetAnnotatedParsedSource (GetAnnotatedParsedSource), - astA) +import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph import Development.IDE.Plugin.CodeAction (newImport, @@ -232,7 +230,7 @@ extendImportHandler' ideState ExtendImport {..} (annsA ps) #endif $ - extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp + extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) Nothing -> do let n = newImport importName sym importQual False sym = if isNothing importQual then Just it else Nothing diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 46a2f937f5..fdc17a5170 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -268,12 +268,6 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = where noParensSnippet = snippetText i (showForSnippet t) snippetText i t = "${" <> T.pack (show i) <> ":" <> t <> "}" -#if MIN_VERSION_ghc(9,2,0) - showForSnippet x = T.pack $ renderWithContext ctxt $ GHC.ppr x -- FIXme - ctxt = defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay} -#else - showForSnippet x = showGhc x -#endif getArgs :: Type -> [Type] getArgs t | isPredTy t = [] @@ -294,6 +288,15 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = | otherwise = [] +showForSnippet :: Outputable a => a -> T.Text +#if MIN_VERSION_ghc(9,2,0) +showForSnippet x = T.pack $ renderWithContext ctxt $ GHC.ppr x -- FIXme + where + ctxt = defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay} +#else +showForSnippet x = showGhc x +#endif + mkModCompl :: T.Text -> CompletionItem mkModCompl label = CompletionItem label (Just CiModule) Nothing Nothing @@ -450,7 +453,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod compls = concat [ case decl of SigD _ (TypeSig _ ids typ) -> - [mkComp id CiFunction (Just $ ppr typ) | id <- ids] + [mkComp id CiFunction (Just $ showForSnippet typ) | id <- ids] ValD _ FunBind{fun_id} -> [ mkComp fun_id CiFunction Nothing | not (hasTypeSig fun_id) @@ -459,12 +462,12 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod [mkComp id CiVariable Nothing | VarPat _ id <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs] TyClD _ ClassDecl{tcdLName, tcdSigs} -> - mkComp tcdLName CiInterface (Just $ ppr tcdLName) : - [ mkComp id CiFunction (Just $ ppr typ) + mkComp tcdLName CiInterface (Just $ showForSnippet tcdLName) : + [ mkComp id CiFunction (Just $ showForSnippet typ) | L _ (ClassOpSig _ _ ids typ) <- tcdSigs , id <- ids] TyClD _ x -> - let generalCompls = [mkComp id cl (Just $ ppr $ tcdLName x) + let generalCompls = [mkComp id cl (Just $ showForSnippet $ tcdLName x) | id <- listify (\(_ :: LIdP GhcPs) -> True) x , let cl = occNameToComKind Nothing (rdrNameOcc $ unLoc id)] -- here we only have to look at the outermost type @@ -473,9 +476,9 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod -- the constructors and snippets will be duplicated here giving the user 2 choices. generalCompls ++ recordCompls ForD _ ForeignImport{fd_name,fd_sig_ty} -> - [mkComp fd_name CiVariable (Just $ ppr fd_sig_ty)] + [mkComp fd_name CiVariable (Just $ showForSnippet fd_sig_ty)] ForD _ ForeignExport{fd_name,fd_sig_ty} -> - [mkComp fd_name CiVariable (Just $ ppr fd_sig_ty)] + [mkComp fd_name CiVariable (Just $ showForSnippet fd_sig_ty)] _ -> [] | L (locA -> pos) decl <- hsmodDecls, let mkComp = mkLocalComp pos @@ -488,7 +491,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod -- to tell local completions and global completions apart -- instead of using the empty string here, we should probably introduce a new field... ensureTypeText = Just $ fromMaybe "" ty - pn = ppr n + pn = showForSnippet n doc = SpanDocText (getDocumentation [pm] $ reLoc n) (SpanDocUris Nothing Nothing) findRecordCompl :: Uri -> ParsedModule -> Provenance -> TyClDecl GhcPs -> [CompItem] @@ -621,8 +624,8 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu where occ = nameOccName name ctyp = occNameToComKind Nothing occ - pn = ppr name - ty = ppr <$> typ + pn = showForSnippet name + ty = showForSnippet <$> typ thisModName = Local $ nameSrcSpan name compls = if T.null prefixModule diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 27af930f68..75c09221a5 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1737,7 +1737,8 @@ extendImportTests = testGroup "extend import actions" , "import A (pattern Some)" , "k (Some x) = x" ]) - , testSession "type constructor name same as data constructor name" $ template + , ignoreForGHC92 "Diagnostic message has no suggestions" $ + testSession "type constructor name same as data constructor name" $ template [("ModuleA.hs", T.unlines [ "module ModuleA where" , "newtype Foo = Foo Int" @@ -3326,7 +3327,8 @@ exportUnusedTests = testGroup "export unused actions" (R 2 0 2 11) "Export ‘bar’" Nothing - , testSession "type is exported but not the constructor of same name" $ template + , ignoreForGHC92 "Diagnostic message has no suggestions" $ + testSession "type is exported but not the constructor of same name" $ template (T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (Foo) where" @@ -4077,7 +4079,7 @@ pluginSimpleTests = pluginParsedResultTests :: TestTree pluginParsedResultTests = ignoreInWindowsForGHC88And810 $ - ignoreForGHC92 $ + ignoreForGHC92 "No need for this plugin anymore!" $ testSessionWithExtraFiles "plugin-recorddot" "parsedResultAction plugin" $ \dir -> do _ <- openDoc (dir "RecordDot.hs") "haskell" expectNoMoreDiagnostics 2 @@ -5217,9 +5219,9 @@ ignoreInWindowsForGHC88And810 ignoreInWindowsBecause "tests are unreliable in windows for ghc 8.8 and 8.10" | otherwise = id -ignoreForGHC92 :: TestTree -> TestTree -ignoreForGHC92 - | ghcVersion == GHC92 = ignoreTestBecause "GHC 9.2" +ignoreForGHC92 :: String -> TestTree -> TestTree +ignoreForGHC92 msg + | ghcVersion == GHC92 = ignoreTestBecause msg | otherwise = id ignoreInWindowsForGHC88 :: TestTree -> TestTree From 802799d9b6f2be520234162f71fb2b40406d2201 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 16:09:35 +0100 Subject: [PATCH 095/149] Enable import lens plugin --- cabal-ghc921.project | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 7162e5fc0d..6b15a9e47b 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -75,8 +75,7 @@ constraints: -retrie -splice -stylishhaskell - -tactic - -importLens, + -tactic, ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, ghc-exactprint >= 1.3, From 685fb09993418aeb3630b171a56633b5bcce6d4c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 16:10:08 +0100 Subject: [PATCH 096/149] WIP test run changes --- ghcide/test/exe/Main.hs | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 75c09221a5..fb9f009fe1 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -15,8 +15,8 @@ module Main (main) where import Control.Applicative.Combinators -import Control.Concurrent.Extra as Concurrent -import Control.Exception (bracket_, catch) +import Control.Concurrent +import Control.Exception (bracket_, catch, finally) import qualified Control.Lens as Lens import Control.Monad import Control.Monad.IO.Class (MonadIO, liftIO) @@ -6011,7 +6011,7 @@ copyTestDataFiles dir prefix = do copyFile ("test/data" prefix f) (dir f) run' :: (FilePath -> Session a) -> IO a -run' s = withTempDir $ \dir -> runInDir dir (s dir) +run' s = withTempDir $ \dir -> testIde' dir IDE.testing $ s dir runInDir :: FilePath -> Session a -> IO a runInDir dir = runInDir' dir "." "." [] @@ -6237,9 +6237,13 @@ findResolution_us delay_us = withTempFile $ \f -> withTempFile $ \f' -> do if t /= t' then return delay_us else findResolution_us (delay_us * 10) -testIde :: IDE.Arguments -> Session () -> IO () -testIde arguments session = do +testIde :: IDE.Arguments -> Session a -> IO a +testIde = testIde' "." + +testIde' :: FilePath -> IDE.Arguments -> Session a -> IO a +testIde' projDir arguments session = do config <- getConfigFromEnv + cwd <- getCurrentDirectory (hInRead, hInWrite) <- createPipe (hOutRead, hOutWrite) <- createPipe let server = IDE.defaultMain arguments @@ -6247,8 +6251,10 @@ testIde arguments session = do , IDE.argsHandleOut = pure hOutWrite } - withAsync server $ \_ -> - runSessionWithHandles hInWrite hOutRead config lspTestCaps "." session + flip finally (setCurrentDirectory cwd) $ withAsync server $ \_ -> + runSessionWithHandles hInWrite hOutRead config lspTestCaps projDir session + + positionMappingTests :: TestTree positionMappingTests = From c8380723b125dbc210292618f213a63fa2bc865a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 17:25:31 +0100 Subject: [PATCH 097/149] Fix GHC 9 build --- ghcide/src/Development/IDE/GHC/Dump.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/ghcide/src/Development/IDE/GHC/Dump.hs index ddcfc87757..0b13d914c1 100644 --- a/ghcide/src/Development/IDE/GHC/Dump.hs +++ b/ghcide/src/Development/IDE/GHC/Dump.hs @@ -8,9 +8,9 @@ import Prelude hiding ((<>)) import qualified Data.ByteString as B import Development.IDE.GHC.Compat.Util (Bag, bagToList) import GHC.Hs -import GHC.Plugins import Generics.SYB (ext1Q, ext2Q, extQ) -import Language.Haskell.GHC.ExactPrint (ExactPrint, exactPrint) +#elif MIN_VERSION_ghc(9,0,1) +import GHC.Plugins #else import GhcPlugins #endif From 707ea98ebaf794f2bd6ba1e17c8bf72143e28d99 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 17:28:27 +0100 Subject: [PATCH 098/149] Undo WIP test changes --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 66764f9219..fcebb03f96 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -6011,7 +6011,7 @@ copyTestDataFiles dir prefix = do copyFile ("test/data" prefix f) (dir f) run' :: (FilePath -> Session a) -> IO a -run' s = withTempDir $ \dir -> testIde' dir IDE.testing $ s dir +run' s = withTempDir $ \dir -> runInDir dir (s dir) runInDir :: FilePath -> Session a -> IO a runInDir dir = runInDir' dir "." "." [] From 7ecab6335c5a210efd8328396d5989d85886f610 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 18:01:50 +0100 Subject: [PATCH 099/149] Fix GHC 8.8 build --- ghcide/src/Development/IDE/GHC/Dump.hs | 11 ++++++++--- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 2 +- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/ghcide/src/Development/IDE/GHC/Dump.hs index 0b13d914c1..744bfdbaef 100644 --- a/ghcide/src/Development/IDE/GHC/Dump.hs +++ b/ghcide/src/Development/IDE/GHC/Dump.hs @@ -2,18 +2,23 @@ module Development.IDE.GHC.Dump(showAstDataHtml) where import Data.Data hiding (Fixity) import Development.IDE.GHC.Compat hiding (NameAnn) +#if MIN_VERSION_ghc(8,10,1) import GHC.Hs.Dump -import Prelude hiding ((<>)) +#else +import HsDumpAst +#endif #if MIN_VERSION_ghc(9,2,1) import qualified Data.ByteString as B -import Development.IDE.GHC.Compat.Util (Bag, bagToList) +import Development.IDE.GHC.Compat.Util import GHC.Hs import Generics.SYB (ext1Q, ext2Q, extQ) -#elif MIN_VERSION_ghc(9,0,1) +#endif +#if MIN_VERSION_ghc(9,0,1) import GHC.Plugins #else import GhcPlugins #endif +import Prelude hiding ((<>)) -- | Show a GHC syntax tree in HTML. #if MIN_VERSION_ghc(9,2,1) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 4382ed645e..f9a9682a3a 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -47,7 +47,7 @@ module Development.IDE.GHC.ExactPrint where import Control.Applicative (Alternative) -import Control.Arrow ((***)) +import Control.Arrow (right, (***)) import Control.Monad import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO) From 2ebfd96fbc5971e3ab48b7f839bdd33024d2cbcc Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 18:21:21 +0100 Subject: [PATCH 100/149] Fix 8.6 build --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index a22ad5d36a..d3796b0d1f 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -153,12 +153,12 @@ findSigOfDecl pred decls = any (pred . unLoc) idsSig ] -findSigOfDeclRanged :: Range -> [LHsDecl GhcPs] -> Maybe (Sig GhcPs) +findSigOfDeclRanged :: forall p p0 . p ~ GhcPass p0 => Range -> [LHsDecl p] -> Maybe (Sig p) findSigOfDeclRanged range decls = do dec <- findDeclContainingLoc (_start range) decls case dec of L _ (SigD _ sig@TypeSig {}) -> Just sig - L _ (ValD _ (bind :: HsBind p)) -> findSigOfBind range (traceAst "bind" bind) + L _ (ValD _ (bind :: HsBind p)) -> findSigOfBind range bind _ -> Nothing findSigOfBind :: forall p p0. p ~ GhcPass p0 => Range -> HsBind p -> Maybe (Sig p) From ba01b3692c5b3d27d557268a7de054266473fca9 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 19:58:21 +0100 Subject: [PATCH 101/149] Fix another exactprint regression --- .../IDE/Plugin/CodeAction/ExactPrint.hs | 33 ++++++++++++++----- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index f418070d24..fe059dec6d 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -49,10 +49,8 @@ import Data.Default import GHC (AddEpAnn (..), AnnContext (..), AnnParen (..), DeltaPos (SameLine), EpAnn (..), EpaLocation (EpaDelta), IsUnicodeSyntax (NormalSyntax), - NameAdornment (NameParens), NameAnn (..), - SrcSpanAnn' (SrcSpanAnn), SrcSpanAnnA, - TrailingAnn (AddCommaAnn), addAnns, ann, emptyComments, - reAnnL) + NameAdornment (NameParens), NameAnn (..), addAnns, ann, emptyComments, + reAnnL, AnnList (..)) #endif import Language.LSP.Types import Development.IDE.GHC.Util @@ -545,17 +543,28 @@ extendHiding symbol (L l idecls) mlies df = do #if !MIN_VERSION_ghc(9,2,0) Nothing -> flip L [] <$> uniqueSrcSpanT #else - Nothing -> flip L [] . noAnnSrcSpanDP0 <$> uniqueSrcSpanT + Nothing -> do + src <- uniqueSrcSpanT + let ann = noAnnSrcSpanDP0 src + ann' = flip (fmap.fmap) ann $ \x -> x + {al_rest = [AddEpAnn AnnHiding (epl 1)] + ,al_open = Just $ AddEpAnn AnnOpenP (epl 1) + ,al_close = Just $ AddEpAnn AnnCloseP (epl 0) + } + return $ L ann' [] #endif Just pr -> pure pr let hasSibling = not $ null lies src <- uniqueSrcSpanT top <- uniqueSrcSpanT rdr <- liftParseAST df symbol +#if MIN_VERSION_ghc(9,2,0) + rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr) +#endif let lie = reLocA $ L src $ IEName rdr x = reLocA $ L top $ IEVar noExtField lie - singleHide = L l' [x] #if !MIN_VERSION_ghc(9,2,0) + singleHide = L l' [x] when (isNothing mlies) $ do addSimpleAnnT singleHide @@ -574,13 +583,21 @@ extendHiding symbol (L l idecls) mlies df = do addTrailingCommaT (head lies) -- Why we need this? else forM_ mlies $ \lies0 -> do transferAnn lies0 singleHide id -#else --- let l'' = flip first l $ fmap.fmap $ (AnnHiding :) #endif return $ L l idecls{ideclHiding = Just (True, L l' $ x : lies)} where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc +addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn +addParens True it@NameAnn{} = + it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } +addParens True it@NameAnnCommas{} = + it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } +addParens True it@NameAnnOnly{} = + it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } +addParens True NameAnnTrailing{..} = + NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..} +addParens _ it = it deleteFromImport :: String -> From 59e2b2f95192412520a5d2fa849cc3d7bd8a0b83 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 20:03:39 +0100 Subject: [PATCH 102/149] Add source repository with ghc-exactprint fixes --- cabal-ghc921.project | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 6b15a9e47b..d5c3220b51 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -27,6 +27,12 @@ packages: ./plugins/hls-call-hierarchy-plugin -- ./plugins/hls-alternate-number-format-plugin +source-repository-package + type: git + location: https://github.com/pepeiborra/ghc-exactprint + tag: 2fe891ae15a89cfb6f1b687abf3af0e3b512c751 + -- https://github.com/alanz/ghc-exactprint/pull/110 + source-repository-package type: git location: https://github.com/Bodigrim/th-extras From a108827f86740ddc264d061ee42d25fdeb16eb62 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 20:22:32 +0100 Subject: [PATCH 103/149] Add source repository for retrie (needed for fixed ghc-exactprint) --- cabal-ghc921.project | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index d5c3220b51..2d3b594199 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -27,6 +27,11 @@ packages: ./plugins/hls-call-hierarchy-plugin -- ./plugins/hls-alternate-number-format-plugin +source-repository-package + type: git + location: https://github.com/pepeiborra/retrie + tag: 5d45dd1d101b6a026281892fe2145b911237824f + source-repository-package type: git location: https://github.com/pepeiborra/ghc-exactprint From 61b77552ff6865edbc8d70a23ecd01efad24fe9f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 2 Jan 2022 23:21:45 +0100 Subject: [PATCH 104/149] fix ghc <9.2 build --- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 11 +++++++++++ .../Development/IDE/Plugin/CodeAction/ExactPrint.hs | 11 ----------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index f9a9682a3a..b688649f24 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -28,6 +28,7 @@ module Development.IDE.GHC.ExactPrint Annotate, setPrecedingLinesT, #else + addParens, addParensToCtxt, modifyAnns, removeComma, @@ -648,4 +649,14 @@ removeComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l) isCommaAnn AddCommaAnn{} = True isCommaAnn _ = False +addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn +addParens True it@NameAnn{} = + it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } +addParens True it@NameAnnCommas{} = + it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } +addParens True it@NameAnnOnly{} = + it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } +addParens True NameAnnTrailing{..} = + NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..} +addParens _ it = it #endif diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index fe059dec6d..d33eeaa1eb 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -588,17 +588,6 @@ extendHiding symbol (L l idecls) mlies df = do where isOperator = not . all isAlphaNum . occNameString . rdrNameOcc -addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn -addParens True it@NameAnn{} = - it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } -addParens True it@NameAnnCommas{} = - it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } -addParens True it@NameAnnOnly{} = - it{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0 } -addParens True NameAnnTrailing{..} = - NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..} -addParens _ it = it - deleteFromImport :: String -> LImportDecl GhcPs -> From 861eabcaed686f3d985efa824e4e78fe2fcfe98a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 00:09:42 +0100 Subject: [PATCH 105/149] Another exactprint fix --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 7 +++---- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 2 +- .../src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 8 ++++++-- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 1d1797d602..95e1ac1a81 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -196,10 +196,11 @@ module Development.IDE.GHC.Compat.Core ( LocatedAn, #if MIN_VERSION_ghc(9,2,0) GHC.AnnListItem(..), + GHC.NameAnn(..), #else AnnListItem, -#endif NameAnn, +#endif SrcLoc.RealLocated, SrcLoc.GenLocated(..), SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan), @@ -1019,9 +1020,7 @@ getLocA x = GHC.getLoc x type AnnListItem = SrcLoc.SrcSpan #endif -#if MIN_VERSION_ghc(9,2,0) -type NameAnn = GHC.NameAnn -#else +#if !MIN_VERSION_ghc(9,2,0) type NameAnn = SrcLoc.SrcSpan #endif diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index b688649f24..0b7c2135c4 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -91,7 +91,7 @@ import GHC (EpAnn (..), SrcSpanAnnA, TrailingAnn (AddCommaAnn), emptyComments, - spanAsAnchor) + spanAsAnchor, NameAnn(..), NameAdornment (NameParens)) import GHC.Parser.Annotation (AnnContext (..), DeltaPos (SameLine), EpaLocation (EpaDelta)) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index d33eeaa1eb..ef9dc4f64c 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -55,7 +55,7 @@ import GHC (AddEpAnn (..), AnnContext (..), AnnParen (..), import Language.LSP.Types import Development.IDE.GHC.Util import Data.Bifunctor (first) -import Control.Lens (_last, over) +import Control.Lens (_head, _last, over) import GHC.Stack (HasCallStack) ------------------------------------------------------------------------------ @@ -563,6 +563,10 @@ extendHiding symbol (L l idecls) mlies df = do #endif let lie = reLocA $ L src $ IEName rdr x = reLocA $ L top $ IEVar noExtField lie +#if MIN_VERSION_ghc(9,2,0) + x <- pure $ if hasSibling then first addComma x else x + lies <- pure $ over _head (`setEntryDP` SameLine 1) lies +#endif #if !MIN_VERSION_ghc(9,2,0) singleHide = L l' [x] when (isNothing mlies) $ do @@ -576,7 +580,7 @@ extendHiding symbol (L l idecls) mlies df = do addSimpleAnnT x (DP (0, 0)) [] addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr if hasSibling - then when hasSibling $ do + then do addTrailingCommaT x addSimpleAnnT (head lies) (DP (0, 1)) [] unless (null $ tail lies) $ From 6c0d201236aed5ff07d80328aaa066a3ef00712d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 10:34:30 +0100 Subject: [PATCH 106/149] Fix benchmarks --- ghcide/bench/lib/Experiments.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/bench/lib/Experiments.hs b/ghcide/bench/lib/Experiments.hs index 6cd7c4478a..6fd08fe444 100644 --- a/ghcide/bench/lib/Experiments.hs +++ b/ghcide/bench/lib/Experiments.hs @@ -252,7 +252,7 @@ configP = <*> option auto (long "timeout" <> value 60 <> help "timeout for waiting for a ghcide response") <*> ( Example "name" <$> (Right <$> packageP) - <*> (some moduleOption <|> pure ["Distribution/Simple.hs"]) + <*> (some moduleOption <|> pure ["src/Distribution/Simple.hs"]) <*> pure [] <|> Example "name" @@ -264,7 +264,7 @@ configP = packageP = ExamplePackage <$> strOption (long "example-package-name" <> value "Cabal") - <*> option versionP (long "example-package-version" <> value (makeVersion [3,4,0,0])) + <*> option versionP (long "example-package-version" <> value (makeVersion [3,6,0,0])) pathP = strOption (long "example-path") versionP :: ReadM Version From 8fe2f760ebacd5e50cecd9ca44307da9591061b1 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 12:51:07 +0100 Subject: [PATCH 107/149] Another exactprint fix --- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 12 +++++++++++- .../Development/IDE/Plugin/CodeAction/ExactPrint.hs | 3 +++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 0b7c2135c4..179d959463 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -36,6 +36,7 @@ module Development.IDE.GHC.ExactPrint eqSrcSpan, epl, epAnn, + removeTrailingComma, #endif annotateParsedSource, getAnnotatedParsedSourceRule, @@ -87,11 +88,13 @@ import Retrie.ExactPrint hiding (parseDecl, parseType) #if MIN_VERSION_ghc(9,2,0) import GHC (EpAnn (..), + NameAdornment (NameParens), + NameAnn (..), SrcSpanAnn' (SrcSpanAnn), SrcSpanAnnA, TrailingAnn (AddCommaAnn), emptyComments, - spanAsAnchor, NameAnn(..), NameAdornment (NameParens)) + spanAsAnchor) import GHC.Parser.Annotation (AnnContext (..), DeltaPos (SameLine), EpaLocation (EpaDelta)) @@ -659,4 +662,11 @@ addParens True it@NameAnnOnly{} = addParens True NameAnnTrailing{..} = NameAnn{nann_adornment = NameParens, nann_open = epl 0, nann_close = epl 0, nann_name = epl 0, ..} addParens _ it = it + +removeTrailingComma :: GenLocated SrcSpanAnnA ast -> GenLocated SrcSpanAnnA ast +removeTrailingComma = flip modifyAnns $ \(AnnListItem l) -> AnnListItem $ filter (not . isCommaAnn) l + +isCommaAnn :: TrailingAnn -> Bool +isCommaAnn AddCommaAnn{} = True +isCommaAnn _ = False #endif diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index ef9dc4f64c..bfff121c1e 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -624,6 +624,9 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do pure lidecl' where deletedLies = +#if MIN_VERSION_ghc(9,2,0) + over _last removeTrailingComma $ +#endif mapMaybe killLie lies killLie :: LIE GhcPs -> Maybe (LIE GhcPs) killLie v@(L _ (IEVar _ (L _ (unqualIEWrapName -> nam)))) From 3dfaebfeae4f3ff63e9b2478e8318f8556031100 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 12:51:25 +0100 Subject: [PATCH 108/149] Disable a plugin test (plugin not compatible anymore) --- ghcide/test/exe/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index fcebb03f96..18a98303eb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4065,6 +4065,7 @@ checkFileCompiles fp diag = pluginSimpleTests :: TestTree pluginSimpleTests = ignoreInWindowsForGHC88And810 $ + ignoreForGHC92 "blocked on ghc-typelits-natnormalise" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" liftIO $ writeFile (dir"hie.yaml") From b095f8b7a414d58f979e1794417f3207308f0aa1 Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 1 Jan 2022 23:15:59 +0100 Subject: [PATCH 109/149] Enable windows build --- .github/workflows/test.yml | 8 +++----- cabal-ghc921.project | 7 +++++++ 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c14a3584b0..2806742ec0 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -84,11 +84,9 @@ jobs: - os: ubuntu-latest ghc: '8.6.5' test: true - # Blocked on unix-compat - # https://github.com/jacobstanley/unix-compat/issues/52 - # - os: windows-latest - # ghc: '9.2.1' - # test: true + - os: windows-latest + ghc: '9.2.1' + test: true - os: windows-latest ghc: '9.0.1' test: true diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 2d3b594199..2e4757acac 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -38,6 +38,13 @@ source-repository-package tag: 2fe891ae15a89cfb6f1b687abf3af0e3b512c751 -- https://github.com/alanz/ghc-exactprint/pull/110 +source-repository-package + type: git + location: https://github.com/tfausak/unix-compat + tag: 154c3a63f154cb49c51d5f9d13488e8119631d8a + -- To fix windows build + -- https://github.com/jacobstanley/unix-compat/pull/47 + source-repository-package type: git location: https://github.com/Bodigrim/th-extras From 20842031fa3c0f9d4203dc9243fb54c88419722d Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 3 Jan 2022 20:23:52 +0530 Subject: [PATCH 110/149] Fix multiple components by using consistent UnitIds There are multiple sources of truth for the home unit id now, in the DynFlags and in the hsc_units --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/Core/Compile.hs | 15 +++++++-------- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 2e4422a51d..9f4222fec0 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -432,7 +432,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do newHscEnv <- -- Add the options for the current component to the HscEnv evalGhcEnv hscEnv $ do - _ <- setSessionDynFlags df + _ <- setSessionDynFlags $ setHomeUnitId_ fakeUid df getSession -- Modify the map so the hieYaml now maps to the newly created diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 0721d9d998..e7ac34b3f2 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -147,24 +147,23 @@ typecheckModule :: IdeDefer -> ParsedModule -> IO (IdeResult TcModuleResult) typecheckModule (IdeDefer defer) hsc keep_lbls pm = do - fmap (either (,Nothing) id) $ - catchSrcErrors (hsc_dflags hsc) "typecheck" $ do - let modSummary = pm_mod_summary pm dflags = ms_hspp_opts modSummary - modSummary' <- initPlugins hsc modSummary - (warnings, tcm) <- withWarnings "typecheck" $ \tweak -> + (warnings, etcm) <- withWarnings "typecheck" $ \tweak -> let session = tweak (hscSetFlags dflags hsc) -- TODO: maybe settings ms_hspp_opts is unnecessary? mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session} in - tcRnModule session keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} + catchSrcErrors (hsc_dflags hsc) "typecheck" $ do + tcRnModule session keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} let errorPipeline = unDefer . hideDiag dflags . tagDiag diags = map errorPipeline warnings deferedError = any fst diags - return (map snd diags, Just $ tcm{tmrDeferedError = deferedError}) + case etcm of + Left errs -> return ((map snd diags) ++ errs, Nothing) + Right tcm -> return (map snd diags, Just $ tcm{tmrDeferedError = deferedError}) where demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id @@ -213,7 +212,7 @@ tcRnModule hsc_env keep_lbls pmod = do unload hsc_env_tmp keep_lbls ((tc_gbl_env, mrn_info), splices) - <- liftIO $ captureSplices (hscSetFlags (ms_hspp_opts ms) hsc_env) $ \hsc_env_tmp -> + <- liftIO $ captureSplices hsc_env_tmp $ \hsc_env_tmp -> do hscTypecheckRename hsc_env_tmp ms $ HsParsedModule { hpm_module = parsedSource pmod, hpm_src_files = pm_extra_src_files pmod, From 65052335d3ae6a7f59b7fba46ea5a78ffa478433 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 3 Jan 2022 20:31:24 +0530 Subject: [PATCH 111/149] Improve error handling for initPlugins --- ghcide/src/Development/IDE/Core/Compile.hs | 34 ++++++++++++---------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index e7ac34b3f2..36fe1b9c66 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -149,21 +149,25 @@ typecheckModule :: IdeDefer typecheckModule (IdeDefer defer) hsc keep_lbls pm = do let modSummary = pm_mod_summary pm dflags = ms_hspp_opts modSummary - modSummary' <- initPlugins hsc modSummary - (warnings, etcm) <- withWarnings "typecheck" $ \tweak -> - let - session = tweak (hscSetFlags dflags hsc) - -- TODO: maybe settings ms_hspp_opts is unnecessary? - mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session} - in - catchSrcErrors (hsc_dflags hsc) "typecheck" $ do - tcRnModule session keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} - let errorPipeline = unDefer . hideDiag dflags . tagDiag - diags = map errorPipeline warnings - deferedError = any fst diags - case etcm of - Left errs -> return ((map snd diags) ++ errs, Nothing) - Right tcm -> return (map snd diags, Just $ tcm{tmrDeferedError = deferedError}) + mmodSummary' <- catchSrcErrors (hsc_dflags hsc) "typecheck (initialize plugins)" + (initPlugins hsc modSummary) + case mmodSummary' of + Left errs -> return (errs, Nothing) + Right modSummary' -> do + (warnings, etcm) <- withWarnings "typecheck" $ \tweak -> + let + session = tweak (hscSetFlags dflags hsc) + -- TODO: maybe settings ms_hspp_opts is unnecessary? + mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session} + in + catchSrcErrors (hsc_dflags hsc) "typecheck" $ do + tcRnModule session keep_lbls $ demoteIfDefer pm{pm_mod_summary = mod_summary''} + let errorPipeline = unDefer . hideDiag dflags . tagDiag + diags = map errorPipeline warnings + deferedError = any fst diags + case etcm of + Left errs -> return ((map snd diags) ++ errs, Nothing) + Right tcm -> return (map snd diags, Just $ tcm{tmrDeferedError = deferedError}) where demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id From 7546d4b1a5f04441b2331114e1255daf05dafb2e Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 3 Jan 2022 21:07:44 +0530 Subject: [PATCH 112/149] Fix two hover tests --- ghcide/test/exe/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 18a98303eb..c29353ee9a 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3978,8 +3978,8 @@ findDefinitionAndHoverTests = let spaceL37 = Position 41 24 ; space = [ExpectNoDefinitions, ExpectHoverText [":: Char"]] docL41 = Position 45 1 ; doc = [ExpectHoverText ["Recognizable docs: kpqz"]] ; constr = [ExpectHoverText ["Monad m"]] - eitL40 = Position 44 28 ; kindE = [ExpectHoverText [":: * -> * -> *\n"]] - intL40 = Position 44 34 ; kindI = [ExpectHoverText [":: *\n"]] + eitL40 = Position 44 28 ; kindE = [ExpectHoverText [if ghcVersion >= GHC92 then ":: Type -> Type -> Type\n" else ":: * -> * -> *\n"]] + intL40 = Position 44 34 ; kindI = [ExpectHoverText [if ghcVersion >= GHC92 then ":: Type\n" else ":: *\n"]] tvrL40 = Position 44 37 ; kindV = [ExpectHoverText [":: * -> *\n"]] intL41 = Position 45 20 ; litI = [ExpectHoverText ["7518"]] chrL36 = Position 41 24 ; litC = [ExpectHoverText ["'f'"]] From c28b15d13ea36ac48b558f1af52897bac1b9c7ff Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 19:52:01 +0100 Subject: [PATCH 113/149] Remove retrie and ghc-exactprint source repos --- cabal-ghc921.project | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 2e4757acac..29c8b5c020 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -27,17 +27,6 @@ packages: ./plugins/hls-call-hierarchy-plugin -- ./plugins/hls-alternate-number-format-plugin -source-repository-package - type: git - location: https://github.com/pepeiborra/retrie - tag: 5d45dd1d101b6a026281892fe2145b911237824f - -source-repository-package - type: git - location: https://github.com/pepeiborra/ghc-exactprint - tag: 2fe891ae15a89cfb6f1b687abf3af0e3b512c751 - -- https://github.com/alanz/ghc-exactprint/pull/110 - source-repository-package type: git location: https://github.com/tfausak/unix-compat @@ -71,7 +60,7 @@ package * write-ghc-environment-files: never -index-state: 2021-12-29T12:30:08Z +index-state: 2022-01-03T18:45:00Z constraints: -- These plugins doesn't work on GHC92 yet From aea3ef8bb7e9ecb1d25efd12951d59b39076a345 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 20:11:30 +0100 Subject: [PATCH 114/149] Fix version of direct-sqlite Not sure why this is needed, but without it Cabal is selecting an older version which fails to build with 9.2 --- cabal-ghc921.project | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 29c8b5c020..7ec1603229 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -87,6 +87,7 @@ constraints: attoparsec ^>= 0.14.3, ghc-exactprint >= 1.3, retrie >= 1.2, + direct-sqlite == 2.3.26, lens >= 5.0.1, primitive-unlifted ==0.1.3.1, -- these constraints are for head.hackage From c3bd8c2925d288082a9d7bf598bc69da27b45a30 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 3 Jan 2022 21:29:02 +0100 Subject: [PATCH 115/149] Fix ci update hackage index --- .github/workflows/bench.yml | 21 ++++++++++++--------- .github/workflows/caching.yml | 31 +++++++++++++++++-------------- .github/workflows/flags.yml | 21 ++++++++++++--------- .github/workflows/hackage.yml | 24 +++++++++++++++++++----- .github/workflows/test.yml | 21 ++++++++++++--------- 5 files changed, 72 insertions(+), 46 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 45dcafe2c6..c2bf2e14a1 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -85,7 +85,19 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV + # We have to restore package sources before `cabal update` + # cause it overwrites the hackage index with the cached one + - name: Hackage sources cache + uses: actions/cache@v2 + env: + cache-name: hackage-sources + with: + path: ${{ env.CABAL_PKGS_DIR }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + restore-keys: ${{ env.cache-name }}- + # To ensure we get the lastest hackage index and not relying on haskell action logic + # It has to be done before `cabal freeze` to make it aware of the new index - run: cabal update - name: Form the package list ('cabal.project.freeze') @@ -100,15 +112,6 @@ jobs: echo 'WARNING: Could not produce the `freeze`.' echo ::set-output name=value::${{ hashFiles('cabal.project.freeze') }} - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - name: Compiled deps cache uses: actions/cache@v2 env: diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index f62533f170..a263195bfd 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -149,7 +149,24 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV + # 2021-12-02: NOTE: Cabal Hackage source tree storage does not depend on OS or GHC really, + # but can depend on `base`. + # But this caching is happens only inside `master` for `master` purposes of compiling the deps + # so having a shared pool here that depends only on Hackage pin & does not depend on `base` is "good enough" + # & used such because it preserves 10% of a global cache storage pool. + # We have to restore package sources before `cabal update` + # cause it overwrites the hackage index with the cached one + - name: Hackage sources cache + uses: actions/cache@v2 + env: + cache-name: hackage-sources + with: + path: ${{ env.CABAL_PKGS_DIR }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + restore-keys: ${{ env.cache-name }}- + # To ensure we get the lastest hackage index and not relying on haskell action logic + # It has to be done before `cabal freeze` to make it aware of the new index - run: cabal update - name: Form the package list ('cabal.project.freeze') @@ -164,20 +181,6 @@ jobs: echo 'WARNING: Could not produce the `freeze`.' echo ::set-output name=value::${{ hashFiles('cabal.project.freeze') }} - # 2021-12-02: NOTE: Cabal Hackage source tree storage does not depend on OS or GHC really, - # but can depend on `base`. - # But this caching is happens only inside `master` for `master` purposes of compiling the deps - # so having a shared pool here that depends only on Hackage pin & does not depend on `base` is "good enough" - # & used such because it preserves 10% of a global cache storage pool. - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - name: Compiled deps cache id: compiled-deps uses: actions/cache@v2 diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index 608d9ed544..4a5338e6f9 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -85,7 +85,19 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV + # We have to restore package sources before `cabal update` + # cause it overwrites the hackage index with the cached one + - name: Hackage sources cache + uses: actions/cache@v2 + env: + cache-name: hackage-sources + with: + path: ${{ env.CABAL_PKGS_DIR }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + restore-keys: ${{ env.cache-name }}- + # To ensure we get the lastest hackage index and not relying on haskell action logic + # It has to be done before `cabal freeze` to make it aware of the new index - run: cabal update - name: Form the package list ('cabal.project.freeze') @@ -102,15 +114,6 @@ jobs: # Removing freeze file as it breaks builds with alternative flags rm -rf cabal.project.freeze - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - name: Compiled deps cache id: compiled-deps uses: actions/cache@v2 diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 7fa7714afd..f3c6bc7baf 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -78,16 +78,33 @@ jobs: cache-name: hackage-sources with: path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} restore-keys: ${{ env.cache-name }}- + # To ensure we get the lastest hackage index and not relying on haskell action logic + # It has to be done before `cabal freeze` to make it aware of the new index + - name: "Ensure we will use hackage head" + run: cabal update + + - name: Compute the cache key + id: compute-cache-key + run: | + cabal v2-freeze && \ + echo "" && \ + echo 'Output:' && \ + echo "" && \ + cat 'cabal.project.freeze' && \ + echo '' || \ + echo 'WARNING: Could not produce the `freeze`.' + echo ::set-output name=value::${{ hashFiles('cabal.project.freeze') }} + - name: Compiled deps cache uses: actions/cache@v2 env: cache-name: compiled-deps with: path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project') }} + key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ steps.compute-cache-key.outputs.value }} restore-keys: | ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- @@ -116,9 +133,6 @@ jobs: - name: "Unpack package source in an isolated location" run: cabal unpack ${{ steps.generate-dist-tarball.outputs.path }} --destdir=./incoming - - name: "Ensure we will use hackage head" - run: cabal update - - name: "Try to get the current hackage version" id: get-hackage-version run: | diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 665411605b..2b203940b4 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -154,7 +154,19 @@ jobs: INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV + # We have to restore package sources before `cabal update` + # cause it overwrites the hackage index with the cached one + - name: Hackage sources cache + uses: actions/cache@v2 + env: + cache-name: hackage-sources + with: + path: ${{ env.CABAL_PKGS_DIR }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + restore-keys: ${{ env.cache-name }}- + # To ensure we get the lastest hackage index and not relying on haskell action logic + # It has to be done before `cabal freeze` to make it aware of the new index - run: cabal update - name: Compute the cache key @@ -169,15 +181,6 @@ jobs: echo 'WARNING: Could not produce the `freeze`.' echo ::set-output name=value::${{ hashFiles('cabal.project.freeze') }} - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - name: Compiled deps cache uses: actions/cache@v2 env: From 78ea4f31fec8b204ed47f35ca7ea93d6e2024dd2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 20:34:01 +0100 Subject: [PATCH 116/149] This test is broken because GHC 9.2 built-in libraries lack docs The interface files have no docs, checked via: ghc --show-iface ~/.ghcup/ghc/9.2.1/lib/ghc-9.2.1/lib/x86_64-osx-ghc-9.2.1/base-4.16.0.0/Data/Functor.hi --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index c29353ee9a..fa163d7eb5 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4045,7 +4045,7 @@ findDefinitionAndHoverTests = let , test no skip cccL17 docLink "Haddock html links" , testM yes yes imported importedSig "Imported symbol" , testM yes yes reexported reexportedSig "Imported symbol (reexported)" - , if ghcVersion == GHC90 && isWindows then + , if ghcVersion == GHC90 && isWindows || ghcVersion == GHC92 then test no broken thLocL57 thLoc "TH Splice Hover" else test no yes thLocL57 thLoc "TH Splice Hover" From 4f016ddca2b005e23963c3d401028d127fc87fd0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 3 Jan 2022 20:35:15 +0100 Subject: [PATCH 117/149] Sanitize hiding tests These tests are reimplementing runWithExtraFiles - let's just use it --- ghcide/test/exe/Main.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index fa163d7eb5..ccfd3e7176 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -2119,20 +2119,15 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti ] ] where - hidingDir = "test/data/hiding" compareTwo original locs cmd expected = withTarget original locs $ \doc actions -> do - expected <- liftIO $ - readFileUtf8 (hidingDir expected) + expected <- liftIO $ readFileUtf8 expected action <- liftIO $ pickActionWithTitle cmd actions executeCodeAction action contentAfterAction <- documentContents doc liftIO $ T.replace "\r\n" "\n" expected @=? contentAfterAction compareHideFunctionTo = compareTwo "HideFunction.hs" - auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"] - withTarget file locs k = withTempDir $ \dir -> runInDir dir $ do - liftIO $ mapM_ (\fp -> copyFile (hidingDir fp) $ dir fp) - $ file : auxFiles + withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do doc <- openDoc file "haskell" waitForProgressDone void $ expectDiagnostics [(file, [(DsError, loc, "Ambiguous occurrence") | loc <- locs])] From 0c325f5b690a76173964509db75f13455bf2da63 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 4 Jan 2022 07:21:09 +0100 Subject: [PATCH 118/149] Disable another test --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index ccfd3e7176..60cdb1cbf6 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4981,7 +4981,7 @@ highlightTests = testGroup "highlight" , DocumentHighlight (R 6 10 6 13) (Just HkRead) , DocumentHighlight (R 7 12 7 15) (Just HkRead) ] - , knownBrokenForGhcVersions [GHC90] "Ghc9 highlights the constructor and not just this field" $ + , knownBrokenForGhcVersions [GHC90, GHC92] "Ghc9 highlights the constructor and not just this field" $ testSessionWait "record" $ do doc <- createDoc "A.hs" "haskell" recsource _ <- waitForDiagnostics From 4e320278def00549473cfad8bdd51a1d15ab2fbc Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 4 Jan 2022 12:05:47 +0530 Subject: [PATCH 119/149] Fix outline --- ghcide/src/Development/IDE/LSP/Outline.hs | 23 ++++++++++++++--------- ghcide/test/exe/Main.hs | 2 +- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 675eece18f..17d6622312 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -29,6 +29,9 @@ import Language.LSP.Types (DocumentSymbol (..), SymbolKind (SkConstructor, SkField, SkFile, SkFunction, SkInterface, SkMethod, SkModule, SkObject, SkStruct, SkTypeParameter, SkUnknown), TextDocumentIdentifier (TextDocumentIdentifier), type (|?) (InL), uriToFilePath) +#if MIN_VERSION_ghc(9,2,0) +import Data.List.NonEmpty (nonEmpty, toList) +#endif moduleOutline :: IdeState -> DocumentSymbolParams -> LspM c (Either ResponseError (List DocumentSymbol |? List SymbolInformation)) @@ -106,12 +109,15 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , _kind = SkConstructor , _selectionRange = realSrcSpanToRange l' #if MIN_VERSION_ghc(9,2,0) - , _children = Just $ List $ childs + , _children = List . toList <$> nonEmpty childs } | con <- dd_cons , let (cs, flds) = hsConDeclsBinders con , let childs = mapMaybe cvtFld flds - , L (RealSrcSpan l' _) n <- cs + , L (locA -> RealSrcSpan l' _) n <- cs + , let l = case con of + L (locA -> RealSrcSpan l _) _ -> l + _ -> l' ] } where @@ -261,7 +267,7 @@ getConNames' (XConDecl x) = noExtCon x #endif #else hsConDeclsBinders :: LConDecl GhcPs - -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs]) + -> ([LIdP GhcPs], [LFieldOcc GhcPs]) -- See hsLTyClDeclBinders for what this does -- The function is boringly complicated because of the records -- And since we only have equality, we have to be a little careful @@ -269,21 +275,20 @@ hsConDeclsBinders cons = go cons where go :: LConDecl GhcPs - -> ([Located (IdP GhcPs)], [LFieldOcc GhcPs]) + -> ([LIdP GhcPs], [LFieldOcc GhcPs]) go r -- Don't re-mangle the location of field names, because we don't -- have a record of the full location of the field declaration anyway - = let loc = getLoc (reLoc r) - in case unLoc r of + = case unLoc r of -- remove only the first occurrence of any seen field in order to -- avoid circumventing detection of duplicate fields (#9156) ConDeclGADT { con_names = names, con_g_args = args } - -> (map (L loc . unLoc) names, flds) + -> (names, flds) where - (flds) = get_flds_gadt args + flds = get_flds_gadt args ConDeclH98 { con_name = name, con_args = args } - -> ([L loc (unLoc name)], flds) + -> ([name], flds) where flds = get_flds_h98 args diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 60cdb1cbf6..b17d1c58c6 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5122,7 +5122,7 @@ outlineTests = testGroup let source = T.unlines ["data A = B {", " x :: Int", " , y :: Int}"] docId <- createDoc "A.hs" "haskell" source symbols <- getDocumentSymbols docId - liftIO $ symbols @=? Left + liftIO $ symbols @?= Left [ docSymbolWithChildren "A" SkStruct (R 0 0 2 13) [ docSymbolWithChildren' "B" SkConstructor (R 0 9 2 13) (R 0 9 0 10) [ docSymbol "x" SkField (R 1 2 1 3) From 16bd035acf01e0f4be0034d2d967661a42fd49aa Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 4 Jan 2022 15:54:18 +0100 Subject: [PATCH 120/149] Revert "Sanitize hiding tests" This reverts commit 4f016ddca2b005e23963c3d401028d127fc87fd0. --- ghcide/test/exe/Main.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index b17d1c58c6..20b30ed0c7 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -2119,15 +2119,20 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti ] ] where + hidingDir = "test/data/hiding" compareTwo original locs cmd expected = withTarget original locs $ \doc actions -> do - expected <- liftIO $ readFileUtf8 expected + expected <- liftIO $ + readFileUtf8 (hidingDir expected) action <- liftIO $ pickActionWithTitle cmd actions executeCodeAction action contentAfterAction <- documentContents doc liftIO $ T.replace "\r\n" "\n" expected @=? contentAfterAction compareHideFunctionTo = compareTwo "HideFunction.hs" - withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do + 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])] From ce57b1dc0eeb87b0cfe33cca42a5c30fc58f6620 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 4 Jan 2022 21:47:38 +0100 Subject: [PATCH 121/149] Extract out ci build setup --- .github/actions/setup-build/action.yml | 111 +++++++++++++++++++++++++ .github/workflows/bench.yml | 68 +-------------- .github/workflows/caching.yml | 96 +-------------------- .github/workflows/flags.yml | 77 +---------------- .github/workflows/hackage.yml | 57 +------------ .github/workflows/test.yml | 87 +------------------ 6 files changed, 126 insertions(+), 370 deletions(-) create mode 100644 .github/actions/setup-build/action.yml diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml new file mode 100644 index 0000000000..bdaa9a0fe4 --- /dev/null +++ b/.github/actions/setup-build/action.yml @@ -0,0 +1,111 @@ +name: "Cached build" +description: "Setup the build using cache" +inputs: + ghc: + description: "Ghc version" + required: true + cabal: + description: "Cabal version" + required: false + default: "3.6" + os: + description: "Operating system: Linux, Windows or macOS" + required: true +runs: + using: "composite" + steps: + - uses: haskell/actions/setup@v1 + id: HaskEnvSetup + with: + ghc-version : ${{ inputs.ghc }} + cabal-version: ${{ inputs.cabal }} + enable-stack: false + + - if: inputs.os == 'Windows' + name: (Windows) Platform config + run: | + echo "CABAL_PKGS_DIR=C:\\cabal\\packages" >> $GITHUB_ENV + - if: ( inputs.os == 'Linux' ) || ( inputs.os == 'macOS' ) + name: (Linux,macOS) Platform config + run: | + echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV + + # Needs to be before Cache Cabal so the cache can detect changes to the modified cabal.project file + - if: inputs.ghc == '9.0.1' || inputs.ghc == '9.2.1' + name: (GHC 9.0/9.2) Use modified `cabal.project` + env: + GHCVER: ${{ inputs.ghc }} + run: | + # File has some protections preventing regular `rm`. + # (most probably sticky bit is set on $HOME) + # `&&` insures `rm -f` return is positive. + # Many platforms aslo have `alias cp='cp -i'`. + rm -f -v cabal.project && cp -v cabal-ghc${GHCVER//./}.project cabal.project + + - if: inputs.os == 'Windows' && inputs.ghc == '8.8.4' + name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults + run: | + echo "package floskell" >> cabal.project + echo " ghc-options: -O0" >> cabal.project + + # Shorten binary names as a workaround for filepath length limits in Windows, + # but since tests are hardcoded on this workaround - + # all platforms (in 2021-12-07) need it. + # All workflows which distinquishes cache on `cabal.project` needs this. + - name: Workaround shorten binary names + run: | + sed -i.bak -e 's/haskell-language-server/hls/g' \ + -e 's/haskell_language_server/hls/g' \ + haskell-language-server.cabal cabal.project + sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ + src/**/*.hs exe/*.hs + + - name: Retrieving `cabal.project` Hackage timestamp + run: | + # Form: index-state: 2021-11-29T08:11:08Z + INDEX_STATE_ENTRY=$(grep index-state cabal.project) + # Form: 2021-11-29T08-11-08Z + INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') + echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV + + # We have to restore package sources before `cabal update` + # cause it overwrites the hackage index with the cached one + - name: Hackage sources cache + uses: actions/cache@v2 + env: + cache-name: hackage-sources + with: + path: ${{ env.CABAL_PKGS_DIR }} + key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} + restore-keys: ${{ env.cache-name }}- + + # To ensure we get the lastest hackage index without telying in the haskell action logic + # It has to be done before `cabal freeze` to make it aware of the new index + - run: cabal update + + - name: Form the package list ('cabal.project.freeze') + run: | + cabal v2-freeze && \ + echo "" && \ + echo 'Output:' && \ + echo "" && \ + cat 'cabal.project.freeze' && \ + echo "" || \ + echo 'WARNING: Could not produce the `freeze`.' + + - name: Compiled deps cache + id: compiled-deps + uses: actions/cache@v2 + env: + cache-name: compiled-deps + with: + path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} + key: ${{ env.cache-name }}-${{ inputs.os }}-${{ inputs.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} + restore-keys: | + ${{ env.cache-name }}-${{ inputs.os }}-${{ inputs.ghc }}-${{ env.INDEX_STATE }}- + ${{ env.cache-name }}-${{ inputs.os }}-${{ inputs.ghc }}- + ${{ env.cache-name }}-${{ inputs.os }}- + + # We remove the freeze file cause it could interfere the build + - name: "Remove freeze file" + run: rm -f cabal.project.freeze diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 37cb975a9b..bcce85f2ee 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -47,7 +47,6 @@ jobs: matrix: ghc: ['8.10.7'] os: [ubuntu-latest] - cabal: ['3.6'] # This code is fitted to the strategy: assumes Linux is used ... etc, # change of the strategy may require changing the bootstrapping/run code @@ -57,71 +56,10 @@ jobs: - run: git fetch origin master # check the master branch for benchmarking - - uses: haskell/actions/setup@v1 - id: HaskEnvSetup - with: - ghc-version : ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} - enable-stack: false - - - name: Linux Platform config - run: | - echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV - - # All workflows which distinquishes cache on `cabal.project` needs this. - - name: Workaround shorten binary names - run: | - sed -i.bak -e 's/haskell-language-server/hls/g' \ - -e 's/haskell_language_server/hls/g' \ - haskell-language-server.cabal cabal.project - sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ - src/**/*.hs exe/*.hs - - - name: Retrieving `cabal.project` Hackage timestamp - run: | - # Form: index-state: 2021-11-29T08:11:08Z - INDEX_STATE_ENTRY=$(grep index-state cabal.project) - # Form: 2021-11-29T08-11-08Z - INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') - echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - # We have to restore package sources before `cabal update` - # cause it overwrites the hackage index with the cached one - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - # To ensure we get the lastest hackage index and not relying on haskell action logic - # It has to be done before `cabal freeze` to make it aware of the new index - - run: cabal update - - - name: Form the package list ('cabal.project.freeze') - run: | - cabal v2-freeze && \ - echo "" && \ - echo 'Output:' && \ - echo "" && \ - cat 'cabal.project.freeze' && \ - echo '' || \ - echo 'WARNING: Could not produce the `freeze`.' - - - name: Compiled deps cache - id: compiled-deps - uses: actions/cache@v2 - env: - cache-name: compiled-deps + - uses: .github/actions/setup-build with: - path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} - restore-keys: | - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- - ${{ env.cache-name }}-${{ runner.os }}- + ghc: ${{ matrix.ghc }} + os: ${{ runner.os }} # max-backjumps is increased as a temporary solution # for dependency resolution failure diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index 6e9a7306c7..c072895735 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -86,104 +86,14 @@ jobs: , "macOS-latest" , "windows-latest" ] - cabal: ['3.6'] steps: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 - id: HaskEnvSetup + - uses: .github/actions/setup-build with: - ghc-version : ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} - enable-stack: false - - - if: runner.os == 'Windows' - name: (Windows) Platform config - run: | - echo "CABAL_PKGS_DIR=C:\\cabal\\packages" >> $GITHUB_ENV - - if: ( runner.os == 'Linux' ) || ( runner.os == 'macOS' ) - name: (Linux,macOS) Platform config - run: | - echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV - - # Needs to be before Cache Cabal so the cache can detect changes to the modified cabal.project file - - if: matrix.ghc == '9.0.1' - name: (GHC 9.0.1) Use modified `cabal.project` - run: | - # File has some protections preventing regular `rm`. - # (most probably sticky bit is set on $HOME) - # `&&` insures `rm -f` return is positive. - # Many platforms also have `alias cp='cp -i'`. - rm -f -v cabal.project && cp -v cabal-ghc901.project cabal.project - - if: runner.os == 'Windows' && matrix.ghc == '8.8.4' - name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults - run: | - echo "package floskell" >> cabal.project - echo " ghc-options: -O0" >> cabal.project - - # Shorten binary names as a workaround for filepath length limits in Windows, - # but since tests are hardcoded on this workaround - - # all platforms (in 2021-12-07) need it. - # All workflows which distinquishes cache on `cabal.project` needs this. - - name: Workaround shorten binary names - run: | - sed -i.bak -e 's/haskell-language-server/hls/g' \ - -e 's/haskell_language_server/hls/g' \ - haskell-language-server.cabal cabal.project - sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ - src/**/*.hs exe/*.hs - - - name: Retrieving `cabal.project` Hackage timestamp - run: | - # Form: index-state: 2021-11-29T08:11:08Z - INDEX_STATE_ENTRY=$(grep index-state cabal.project) - # Form: 2021-11-29T08-11-08Z - INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') - echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - # 2021-12-02: NOTE: Cabal Hackage source tree storage does not depend on OS or GHC really, - # but can depend on `base`. - # But this caching is happens only inside `master` for `master` purposes of compiling the deps - # so having a shared pool here that depends only on Hackage pin & does not depend on `base` is "good enough" - # & used such because it preserves 10% of a global cache storage pool. - # We have to restore package sources before `cabal update` - # cause it overwrites the hackage index with the cached one - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - # To ensure we get the lastest hackage index and not relying on haskell action logic - # It has to be done before `cabal freeze` to make it aware of the new index - - run: cabal update - - - name: Form the package list ('cabal.project.freeze') - run: | - cabal v2-freeze && \ - echo "" && \ - echo 'Output:' && \ - echo "" && \ - cat 'cabal.project.freeze' && \ - echo '' || \ - echo 'WARNING: Could not produce the `freeze`.' - - - name: Compiled deps cache - id: compiled-deps - uses: actions/cache@v2 - env: - cache-name: compiled-deps - with: - path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} - restore-keys: | - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- - ${{ env.cache-name }}-${{ runner.os }}- + ghc: ${{ matrix.ghc }} + os: ${{ runner.os }} - if: steps.compiled-deps.outputs.cache-hit != 'true' && runner.os == 'Linux' && matrix.ghc == '8.10.7' name: Download sources for bench diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index ac95aeac80..4f37b7f7b8 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -47,85 +47,14 @@ jobs: ] os: [ "ubuntu-latest" ] - cabal: ['3.6'] steps: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 - id: HaskEnvSetup + - uses: .github/actions/setup-build with: - ghc-version : ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} - enable-stack: false - - - if: runner.os == 'Windows' - name: (Windows) Platform config - run: | - echo "CABAL_PKGS_DIR=C:\\cabal\\packages" >> $GITHUB_ENV - - if: ( runner.os == 'Linux' ) || ( runner.os == 'macOS' ) - name: (Linux,macOS) Platform config - run: | - echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV - - # All workflows which distinquishes cache on `cabal.project` needs this. - - name: Workaround shorten binary names - run: | - sed -i.bak -e 's/haskell-language-server/hls/g' \ - -e 's/haskell_language_server/hls/g' \ - haskell-language-server.cabal cabal.project - sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ - src/**/*.hs exe/*.hs - - - name: Retrieving `cabal.project` Hackage timestamp - run: | - # Form: index-state: 2021-11-29T08:11:08Z - INDEX_STATE_ENTRY=$(grep index-state cabal.project) - # Form: 2021-11-29T08-11-08Z - INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') - echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - # We have to restore package sources before `cabal update` - # cause it overwrites the hackage index with the cached one - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - # To ensure we get the lastest hackage index and not relying on haskell action logic - # It has to be done before `cabal freeze` to make it aware of the new index - - run: cabal update - - - name: Form the package list ('cabal.project.freeze') - run: | - cabal v2-freeze && \ - echo "" && \ - echo 'Output:' && \ - echo "" && \ - cat 'cabal.project.freeze' && \ - echo '' || \ - echo 'WARNING: Could not produce the `freeze`.' - - - name: Compiled deps cache - id: compiled-deps - uses: actions/cache@v2 - env: - cache-name: compiled-deps - with: - path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} - restore-keys: | - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- - ${{ env.cache-name }}-${{ runner.os }}- - - # Removing freeze file cause it breaks builds with alternative flags - - name: Remove freeze file - run: rm -f cabal.project.freeze + ghc: ${{ matrix.ghc }} + os: ${{ runner.os }} - name: Build `hls-graph` with flags run: cabal v2-build hls-graph --flags="pedantic embed-files stm-stats" diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 0c16b40cfd..da0f08e0ba 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -53,61 +53,10 @@ jobs: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 - id: HaskEnvSetup + - uses: .github/actions/setup-build with: - ghc-version : ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} - enable-stack: false - - - name: Linux Platform config - run: | - echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV - - - name: Retrieving `cabal.project` Hackage timestamp - run: | - # Form: index-state: 2021-11-29T08:11:08Z - INDEX_STATE_ENTRY=$(grep index-state cabal.project) - # Form: 2021-11-29T08-11-08Z - INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') - echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - # To ensure we get the lastest hackage index and not relying on haskell action logic - # It has to be done before `cabal freeze` to make it aware of the new index - - name: "Ensure we will use hackage head" - run: cabal update - - - name: Form the package list ('cabal.project.freeze') - run: | - cabal v2-freeze && \ - echo "" && \ - echo 'Output:' && \ - echo "" && \ - cat 'cabal.project.freeze' && \ - echo '' || \ - echo 'WARNING: Could not produce the `freeze`.' - - - name: Compiled deps cache - id: compiled-deps - uses: actions/cache@v2 - env: - cache-name: compiled-deps - with: - path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} - restore-keys: | - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- - ${{ env.cache-name }}-${{ runner.os }}- + ghc: ${{ matrix.ghc }} + os: ${{ runner.os }} - name: "Run cabal check" run: | diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index f83653a0be..aeae84d34c 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -98,91 +98,10 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 - id: HaskEnvSetup + - uses: .github/actions/setup-build with: - ghc-version : ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} - enable-stack: false - - - if: runner.os == 'Windows' - name: (Windows) Platform config - run: | - echo "CABAL_PKGS_DIR=C:\\cabal\\packages" >> $GITHUB_ENV - - if: ( runner.os == 'Linux' ) || ( runner.os == 'macOS' ) - name: (Linux,macOS) Platform config - run: | - echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV - - # Needs to be before Cache Cabal so the cache can detect changes to the modified cabal.project file - - if: matrix.ghc == '9.0.1' - name: (GHC 9.0) Use modified `cabal.project` - run: | - # File has some protections preventing regular `rm`. - # (most probably sticky bit is set on $HOME) - # `&&` insures `rm -f` return is positive. - # Many platforms aslo have `alias cp='cp -i'`. - rm -f -v cabal.project && cp -v cabal-ghc901.project cabal.project - - if: runner.os == 'Windows' && matrix.ghc == '8.8.4' - name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults - run: | - echo "package floskell" >> cabal.project - echo " ghc-options: -O0" >> cabal.project - - # All workflows which distinquishes cache on `cabal.project` needs this. - - name: Workaround shorten binary names - run: | - sed -i.bak -e 's/haskell-language-server/hls/g' \ - -e 's/haskell_language_server/hls/g' \ - haskell-language-server.cabal cabal.project - sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ - src/**/*.hs exe/*.hs - - - name: Retrieving `cabal.project` Hackage timestamp - run: | - # Form: index-state: 2021-11-29T08:11:08Z - INDEX_STATE_ENTRY=$(grep index-state cabal.project) - # Form: 2021-11-29T08-11-08Z - INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') - echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV - - # We have to restore package sources before `cabal update` - # cause it overwrites the hackage index with the cached one - - name: Hackage sources cache - uses: actions/cache@v2 - env: - cache-name: hackage-sources - with: - path: ${{ env.CABAL_PKGS_DIR }} - key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} - restore-keys: ${{ env.cache-name }}- - - # To ensure we get the lastest hackage index and not relying on haskell action logic - # It has to be done before `cabal freeze` to make it aware of the new index - - run: cabal update - - - name: Form the package list ('cabal.project.freeze') - run: | - cabal v2-freeze && \ - echo "" && \ - echo 'Output:' && \ - echo "" && \ - cat 'cabal.project.freeze' && \ - echo '' || \ - echo 'WARNING: Could not produce the `freeze`.' - - - name: Compiled deps cache - id: compiled-deps - uses: actions/cache@v2 - env: - cache-name: compiled-deps - with: - path: ${{ steps.HaskEnvSetup.outputs.cabal-store }} - key: ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}-${{ hashFiles('cabal.project.freeze') }} - restore-keys: | - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}-${{ env.INDEX_STATE }}- - ${{ env.cache-name }}-${{ runner.os }}-${{ matrix.ghc }}- - ${{ env.cache-name }}-${{ runner.os }}- + ghc: ${{ matrix.ghc }} + os: ${{ runner.os }} # repeating builds to workaround segfaults in windows and ghc-8.8.4 - name: Build From 67f9b92c11cc2178073b0c7e519cf65a7f38e9df Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 4 Jan 2022 21:52:07 +0100 Subject: [PATCH 122/149] Correct action path --- .github/workflows/bench.yml | 2 +- .github/workflows/caching.yml | 2 +- .github/workflows/flags.yml | 2 +- .github/workflows/hackage.yml | 2 +- .github/workflows/test.yml | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index bcce85f2ee..d99683fc52 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -56,7 +56,7 @@ jobs: - run: git fetch origin master # check the master branch for benchmarking - - uses: .github/actions/setup-build + - uses: ./.github/actions/setup-build with: ghc: ${{ matrix.ghc }} os: ${{ runner.os }} diff --git a/.github/workflows/caching.yml b/.github/workflows/caching.yml index c072895735..bb8dcb3583 100644 --- a/.github/workflows/caching.yml +++ b/.github/workflows/caching.yml @@ -90,7 +90,7 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: .github/actions/setup-build + - uses: ./.github/actions/setup-build with: ghc: ${{ matrix.ghc }} os: ${{ runner.os }} diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index 4f37b7f7b8..6f2f3d0b6d 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -51,7 +51,7 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: .github/actions/setup-build + - uses: ./.github/actions/setup-build with: ghc: ${{ matrix.ghc }} os: ${{ runner.os }} diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index da0f08e0ba..7093fa9a62 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -53,7 +53,7 @@ jobs: - uses: actions/checkout@v2 - - uses: .github/actions/setup-build + - uses: ./.github/actions/setup-build with: ghc: ${{ matrix.ghc }} os: ${{ runner.os }} diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index aeae84d34c..c7a8eadcde 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -98,7 +98,7 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: .github/actions/setup-build + - uses: ./.github/actions/setup-build with: ghc: ${{ matrix.ghc }} os: ${{ runner.os }} From 2c885080990cd9ec2a229a57cc9d33bab6307787 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 4 Jan 2022 21:57:16 +0100 Subject: [PATCH 123/149] Add required shell property --- .github/actions/setup-build/action.yml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index bdaa9a0fe4..c94dc77b73 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -25,10 +25,12 @@ runs: name: (Windows) Platform config run: | echo "CABAL_PKGS_DIR=C:\\cabal\\packages" >> $GITHUB_ENV + shell: bash - if: ( inputs.os == 'Linux' ) || ( inputs.os == 'macOS' ) name: (Linux,macOS) Platform config run: | echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV + shell: bash # Needs to be before Cache Cabal so the cache can detect changes to the modified cabal.project file - if: inputs.ghc == '9.0.1' || inputs.ghc == '9.2.1' @@ -41,12 +43,14 @@ runs: # `&&` insures `rm -f` return is positive. # Many platforms aslo have `alias cp='cp -i'`. rm -f -v cabal.project && cp -v cabal-ghc${GHCVER//./}.project cabal.project + shell: bash - if: inputs.os == 'Windows' && inputs.ghc == '8.8.4' name: (Windows,GHC 8.8) Modify `cabal.project` to workaround segfaults run: | echo "package floskell" >> cabal.project echo " ghc-options: -O0" >> cabal.project + shell: bash # Shorten binary names as a workaround for filepath length limits in Windows, # but since tests are hardcoded on this workaround - @@ -59,6 +63,7 @@ runs: haskell-language-server.cabal cabal.project sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ src/**/*.hs exe/*.hs + shell: bash - name: Retrieving `cabal.project` Hackage timestamp run: | @@ -67,6 +72,7 @@ runs: # Form: 2021-11-29T08-11-08Z INDEX_STATE1=$(echo "$INDEX_STATE_ENTRY" | cut -d' ' -f2 | tr ':' '-') echo "INDEX_STATE=$INDEX_STATE1" >> $GITHUB_ENV + shell: bash # We have to restore package sources before `cabal update` # cause it overwrites the hackage index with the cached one @@ -82,6 +88,7 @@ runs: # To ensure we get the lastest hackage index without telying in the haskell action logic # It has to be done before `cabal freeze` to make it aware of the new index - run: cabal update + shell: bash - name: Form the package list ('cabal.project.freeze') run: | @@ -92,6 +99,7 @@ runs: cat 'cabal.project.freeze' && \ echo "" || \ echo 'WARNING: Could not produce the `freeze`.' + shell: bash - name: Compiled deps cache id: compiled-deps @@ -109,3 +117,4 @@ runs: # We remove the freeze file cause it could interfere the build - name: "Remove freeze file" run: rm -f cabal.project.freeze + shell: bash From 3bbc8b7d5e546fa8ecc9e8edd954e9104c51424d Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 4 Jan 2022 22:26:10 +0100 Subject: [PATCH 124/149] Remove unused cabal version --- .github/workflows/hackage.yml | 1 - .github/workflows/test.yml | 1 - 2 files changed, 2 deletions(-) diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml index 7093fa9a62..56e2acb724 100644 --- a/.github/workflows/hackage.yml +++ b/.github/workflows/hackage.yml @@ -38,7 +38,6 @@ jobs: "8.10.7", "8.8.4", "8.6.5"] - cabal: ['3.6'] exclude: - ghc: "9.0.1" package: "hls-brittany-plugin" diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c7a8eadcde..fa597e173b 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -65,7 +65,6 @@ jobs: os: [ "ubuntu-latest" , "macOS-latest" ] - cabal: ['3.6'] include: # only test supported ghc major versions - os: ubuntu-latest From 378c1cef999207c3136f1e11ea0e5da01384fc39 Mon Sep 17 00:00:00 2001 From: Javier Neira Date: Wed, 5 Jan 2022 12:58:43 +0100 Subject: [PATCH 125/149] Update .github/actions/setup-build/action.yml Co-authored-by: Michael Peyton Jones --- .github/actions/setup-build/action.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index c94dc77b73..385558a78f 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -75,7 +75,7 @@ runs: shell: bash # We have to restore package sources before `cabal update` - # cause it overwrites the hackage index with the cached one + # because it overwrites the hackage index with the cached one - name: Hackage sources cache uses: actions/cache@v2 env: From c0e1903d9011d661ad3606c204ecc87d4a3bcf7d Mon Sep 17 00:00:00 2001 From: Javier Neira Date: Wed, 5 Jan 2022 12:59:02 +0100 Subject: [PATCH 126/149] Update .github/actions/setup-build/action.yml Co-authored-by: Michael Peyton Jones --- .github/actions/setup-build/action.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index 385558a78f..833833f627 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -32,7 +32,7 @@ runs: echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV shell: bash - # Needs to be before Cache Cabal so the cache can detect changes to the modified cabal.project file + # Needs to be before the caching step so that the cache can detect changes to the modified cabal.project file - if: inputs.ghc == '9.0.1' || inputs.ghc == '9.2.1' name: (GHC 9.0/9.2) Use modified `cabal.project` env: From b422d5f7c0b12a468f30e882f5270b346278eb48 Mon Sep 17 00:00:00 2001 From: Javier Neira Date: Wed, 5 Jan 2022 13:10:15 +0100 Subject: [PATCH 127/149] Update .github/actions/setup-build/action.yml Co-authored-by: Michael Peyton Jones --- .github/actions/setup-build/action.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index 833833f627..de47183714 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -114,7 +114,7 @@ runs: ${{ env.cache-name }}-${{ inputs.os }}-${{ inputs.ghc }}- ${{ env.cache-name }}-${{ inputs.os }}- - # We remove the freeze file cause it could interfere the build + # We remove the freeze file because it could interfere with the build - name: "Remove freeze file" run: rm -f cabal.project.freeze shell: bash From c3dfb4dd53cd3a91779e932a64299b092ec47271 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 5 Jan 2022 17:42:28 +0530 Subject: [PATCH 128/149] Fix remaining tests and some warnings --- cabal-ghc901.project | 1 + ghcide/src/Development/IDE/GHC/Compat/Core.hs | 6 +++++ ghcide/src/Development/IDE/GHC/Compat/Env.hs | 2 ++ .../Development/IDE/GHC/Compat/ExactPrint.hs | 2 ++ .../Development/IDE/GHC/Compat/Outputable.hs | 11 +++++++-- .../src/Development/IDE/GHC/Compat/Parser.hs | 1 - .../src/Development/IDE/GHC/Compat/Units.hs | 3 +++ ghcide/src/Development/IDE/GHC/Dump.hs | 4 ++-- ghcide/src/Development/IDE/Main.hs | 2 +- .../Development/IDE/Plugin/CodeAction/Args.hs | 2 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 7 ++++++ ghcide/test/exe/Main.hs | 24 ++++++++++--------- 12 files changed, 47 insertions(+), 18 deletions(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index f813020ae7..63d9fa5f6b 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -47,6 +47,7 @@ constraints: -- although we are not building all plugins cabal solver phase is run for all packages -- this way we track explicitly all transitive dependencies which need support for ghc-9 allow-newer: + *:ghc-bignum, brittany:base, brittany:ghc, brittany:ghc-boot-th, diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 95e1ac1a81..f64984d0cf 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -472,6 +472,7 @@ import GHC.Core.FamInstEnv hiding (pprFamInst) import GHC.Core.InstEnv import GHC.Types.Unique.FM #if MIN_VERSION_ghc(9,2,0) +import GHC.Data.Bag import GHC.Core.Multiplicity (scaledThing) #else import GHC.Core.Ppr.TyThing hiding (pprFamInst) @@ -821,7 +822,9 @@ instance HasSrcSpan (SrcSpanAnn' ann) where instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where getLoc (L l _) = l +pattern L :: HasSrcSpan a => SrcSpan -> e -> SrcLoc.GenLocated a e pattern L l a <- GHC.L (getLoc -> l) a +{-# COMPLETE L #-} #endif #elif MIN_VERSION_ghc(8,8,0) @@ -1004,12 +1007,14 @@ type LocatedAn a = GHC.Located #endif #if MIN_VERSION_ghc(9,2,0) +locA :: SrcSpanAnn' a -> SrcSpan locA = GHC.locA #else locA = id #endif #if MIN_VERSION_ghc(9,2,0) +getLocA :: SrcLoc.GenLocated (SrcSpanAnn' a) e -> SrcSpan getLocA = GHC.getLocA #else -- getLocA :: HasSrcSpan a => a -> SrcSpan @@ -1035,6 +1040,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} #endif #if MIN_VERSION_ghc(9,2,0) +collectHsBindsBinders :: CollectPass p => Bag (XRec p (HsBindLR p idR)) -> [IdP p] collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index c245195c79..7662587898 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -81,8 +81,10 @@ import Module #endif #if MIN_VERSION_ghc(9,0,0) +#if !MIN_VERSION_ghc(9,2,0) import qualified Data.Set as Set #endif +#endif #if !MIN_VERSION_ghc(9,2,0) import Data.IORef #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs index 1b085f5192..83e92ddcba 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs @@ -11,7 +11,9 @@ module Development.IDE.GHC.Compat.ExactPrint ) where import Language.Haskell.GHC.ExactPrint +#if !MIN_VERSION_ghc(9,2,0) import Retrie.ExactPrint (Annotated (..)) +#endif #if !MIN_VERSION_ghc(9,2,0) class ExactPrint ast where diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 354d013d07..e3a4ecabe2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -43,7 +43,6 @@ import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Unit.State import GHC.Utils.Error hiding (mkWarnMsg) -import GHC.Utils.Logger import GHC.Utils.Outputable import GHC.Utils.Panic #elif MIN_VERSION_ghc(9,0,0) @@ -138,7 +137,15 @@ pprError = formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String formatErrorWithQual dflags e = #if MIN_VERSION_ghc(9,2,0) - showSDoc dflags (pprLocMsgEnvelope e) + showSDoc dflags (pprNoLocMsgEnvelope e) + +pprNoLocMsgEnvelope :: Error.RenderableDiagnostic e => MsgEnvelope e -> SDoc +pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e + , errMsgContext = unqual }) + = sdocWithContext $ \ctx -> + withErrStyle unqual $ + (formatBulleted ctx $ Error.renderDiagnostic e) + #else Out.showSDoc dflags $ Out.withPprStyle (oldMkErrStyle dflags $ errMsgContext e) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 0e3e6e5072..976f09ded1 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -57,7 +57,6 @@ import GHC (pm_extra_src_files, import qualified GHC import qualified GHC.Driver.Config as Config import GHC.Hs (hpm_module, hpm_src_files) -import qualified GHC.Hs as GHC import GHC.Parser.Lexer hiding (initParserState) #endif #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index d4a51becbd..9077745aef 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -279,8 +279,11 @@ unitHaddockInterfaces = -- ------------------------------------------------------------------ #if MIN_VERSION_ghc(9,2,0) +definiteUnitId :: Definite uid -> GenUnit uid definiteUnitId = RealUnit +defUnitId :: unit -> Definite unit defUnitId = Definite +installedModule :: unit -> ModuleName -> GenModule unit installedModule = Module #elif MIN_VERSION_ghc(9,0,0) diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/ghcide/src/Development/IDE/GHC/Dump.hs index 744bfdbaef..40bd97b54c 100644 --- a/ghcide/src/Development/IDE/GHC/Dump.hs +++ b/ghcide/src/Development/IDE/GHC/Dump.hs @@ -28,7 +28,7 @@ showAstDataHtml :: (Data a, Outputable a) => a -> SDoc #endif showAstDataHtml a0 = html $ header $$ - body (tag' [("id",text (show "myUL"))] "ul" $ vcat + body (tag' [("id",text (show @String "myUL"))] "ul" $ vcat [ #if MIN_VERSION_ghc(9,2,1) li (pre $ text (exactPrint a0)), @@ -44,7 +44,7 @@ showAstDataHtml a0 = html $ angleBrackets (text t <+> hcat [text a<>char '=' <>v | (a,v) <- attrs]) <> cont <> angleBrackets (char '/' <> text t) - ul = tag' [("class", text (show "nested"))] "ul" + ul = tag' [("class", text (show @String "nested"))] "ul" li = tag "li" caret x = tag' [("class", text "caret")] "span" "" <+> x nested foo cts diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 74929b3673..1a101cdc1d 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -80,7 +80,7 @@ import Development.IDE.Types.Options (IdeGhcSession, defaultIdeOptions, optModifyDynFlags, optTesting) -import Development.IDE.Types.Shake (Key (Key), fromKeyType) +import Development.IDE.Types.Shake (fromKeyType) import GHC.Conc (getNumProcessors) import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index 14abdce685..e5b606485b 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -119,8 +119,8 @@ instance ToTextEdit Rewrite where toTextEdit CodeActionArgs {..} rw = fmap (fromMaybe []) $ runMaybeT $ do df <- MaybeT caaDf - ps <- MaybeT caaAnnSource #if !MIN_VERSION_ghc(9,2,0) + ps <- MaybeT caaAnnSource let r = rewriteToEdit df (annsA ps) rw #else let r = rewriteToEdit df rw diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 4f7084badb..d5826fa7c5 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} -- | An HLS plugin to provide code lenses for type signatures @@ -67,6 +68,9 @@ import Language.LSP.Types (ApplyWorkspaceEditParams ( TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit)) import Text.Regex.TDFA ((=~), (=~~)) +#if MIN_VERSION_ghc(9,2,0) +import GHC.Utils.Outputable (SDocContext(..), updSDocContext) +#endif typeLensCommandId :: T.Text typeLensCommandId = "typesignature.add" @@ -216,6 +220,9 @@ instance A.FromJSON Mode where showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String showDocRdrEnv env rdrEnv = showSDocForUser' env (mkPrintUnqualifiedDefault env rdrEnv) +#if MIN_VERSION_ghc(9,2,0) + . updSDocContext (\ctx -> ctx { sdocPrintExplicitKinds = False }) +#endif data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs deriving (Generic, Show, Eq, Ord, Hashable, NFData) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 20b30ed0c7..74e9034b2c 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -2527,9 +2527,9 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" return (action, actionTitle) addTypeAnnotationsToLiteralsTest :: TestTree -addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals to satisfy contraints" +addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals to satisfy constraints" [ - testSession "add default type to satisfy one contraint" $ + testSession "add default type to satisfy one constraint" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "module A (f) where" @@ -2544,7 +2544,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "f = (1 :: Integer)" ]) - , testSession "add default type to satisfy one contraint in nested expressions" $ + , testSession "add default type to satisfy one constraint in nested expressions" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "module A where" @@ -2562,7 +2562,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , " let x = (3 :: Integer)" , " in x" ]) - , testSession "add default type to satisfy one contraint in more nested expressions" $ + , testSession "add default type to satisfy one constraint in more nested expressions" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "module A where" @@ -2580,7 +2580,7 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , " let x = let y = (5 :: Integer) in y" , " in x" ]) - , testSession "add default type to satisfy one contraint with duplicate literals" $ + , testSession "add default type to satisfy one constraint with duplicate literals" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -2602,7 +2602,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f = seq (\"debug\" :: " <> listOfChar <> ") traceShow \"debug\"" ]) - , testSession "add default type to satisfy two contraints" $ + , knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $ + testSession "add default type to satisfy two constraints" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -2622,7 +2623,8 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t , "" , "f a = traceShow (\"debug\" :: " <> listOfChar <> ") a" ]) - , testSession "add default type to satisfy two contraints with duplicate literals" $ + , knownBrokenForGhcVersions [GHC92] "GHC 9.2 only has 'traceShow' in error span" $ + testSession "add default type to satisfy two constraints with duplicate literals" $ testFor (T.unlines [ "{-# OPTIONS_GHC -Wtype-defaults #-}" , "{-# LANGUAGE OverloadedStrings #-}" @@ -3301,7 +3303,7 @@ addSigActionTests = let , "pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)" >:: "pattern Point :: a -> b -> (a, b)" , "pattern MkT1' b = MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" , "pattern MkT1' b <- MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" - , "pattern MkT1' b <- MkT1 42 b\n where MkT1' b = T1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" + , "pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" ] exportUnusedTests :: TestTree @@ -3820,7 +3822,7 @@ addSigLensesTests = , ("pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)", "pattern Point :: a -> b -> (a, b)") , ("pattern MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") , ("pattern MkT1' b <- MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") - , ("pattern MkT1' b <- MkT1 42 b\n where MkT1' b = T1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") + , ("pattern MkT1' b <- MkT1 42 b\n where MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") , ("qualifiedSigTest= C.realPart", "qualifiedSigTest :: C.Complex a -> a") , ("head = 233", "head :: Integer") , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, " <> listOfChar <> ")") @@ -4045,7 +4047,7 @@ findDefinitionAndHoverTests = let , test no skip cccL17 docLink "Haddock html links" , testM yes yes imported importedSig "Imported symbol" , testM yes yes reexported reexportedSig "Imported symbol (reexported)" - , if ghcVersion == GHC90 && isWindows || ghcVersion == GHC92 then + , if ghcVersion == GHC90 && isWindows then test no broken thLocL57 thLoc "TH Splice Hover" else test no yes thLocL57 thLoc "TH Splice Hover" @@ -5388,7 +5390,7 @@ dependentFileTest = testGroup "addDependentFile" expectDiagnostics $ if ghcVersion >= GHC90 -- String vs [Char] causes this change in error message - then [("Foo.hs", [(DsError, (4, 6), "Couldn't match type")])] + then [("Foo.hs", [(DsError, if ghcVersion >= GHC92 then (4,11) else (4, 6), "Couldn't match type")])] else [("Foo.hs", [(DsError, (4, 6), "Couldn't match expected type")])] -- Now modify the dependent file liftIO $ writeFile depFilePath "B" From 8cd5e7fdc6d0568d0e219caae2cb970523c370cf Mon Sep 17 00:00:00 2001 From: Javier Neira Date: Wed, 5 Jan 2022 13:17:48 +0100 Subject: [PATCH 129/149] Update .github/actions/setup-build/action.yml Co-Authored-By: @michaelpj --- .github/actions/setup-build/action.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index de47183714..b13f76a1f1 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -85,7 +85,7 @@ runs: key: ${{ env.cache-name }}-${{ env.INDEX_STATE }} restore-keys: ${{ env.cache-name }}- - # To ensure we get the lastest hackage index without telying in the haskell action logic + # To ensure we get the latest hackage index without relying on the haskell action logic # It has to be done before `cabal freeze` to make it aware of the new index - run: cabal update shell: bash From 186d93dec9449ad635afe07f15a170b0989fb334 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 5 Jan 2022 13:35:53 +0100 Subject: [PATCH 130/149] Copy alt project file unconditionally --- .github/actions/setup-build/action.yml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index b13f76a1f1..15134ac9ea 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -32,9 +32,10 @@ runs: echo "CABAL_PKGS_DIR=~/.cabal/packages" >> $GITHUB_ENV shell: bash + # This copy an alternative cabal-ghc${GHCVER}.project (for example cabal-ghc921.project) + # as main cabal-project, for not fully supported ghc versions # Needs to be before the caching step so that the cache can detect changes to the modified cabal.project file - - if: inputs.ghc == '9.0.1' || inputs.ghc == '9.2.1' - name: (GHC 9.0/9.2) Use modified `cabal.project` + - name: Use possible modified `cabal.project` env: GHCVER: ${{ inputs.ghc }} run: | @@ -42,7 +43,10 @@ runs: # (most probably sticky bit is set on $HOME) # `&&` insures `rm -f` return is positive. # Many platforms aslo have `alias cp='cp -i'`. - rm -f -v cabal.project && cp -v cabal-ghc${GHCVER//./}.project cabal.project + ALT_PROJECT_FILE=cabal-ghc${GHCVER//./}.project + if [[ -f "$ALT_PROJECT_FILE" ]]; then + rm -f -v cabal.project && cp -v "$ALT_PROJECT_FILE" cabal.project + fi shell: bash - if: inputs.os == 'Windows' && inputs.ghc == '8.8.4' From 271911014fbf5b64b846f16cec4cfd8056dffa02 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 5 Jan 2022 13:38:46 +0100 Subject: [PATCH 131/149] Make freeze strict --- .github/actions/setup-build/action.yml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index 15134ac9ea..5a697555cc 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -100,9 +100,7 @@ runs: echo "" && \ echo 'Output:' && \ echo "" && \ - cat 'cabal.project.freeze' && \ - echo "" || \ - echo 'WARNING: Could not produce the `freeze`.' + cat 'cabal.project.freeze' shell: bash - name: Compiled deps cache From 6e53b6fbe743f19bbfa8438a853969df58f5219f Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 5 Jan 2022 18:22:00 +0530 Subject: [PATCH 132/149] Actually fix tests --- ghcide/src/Development/IDE/Plugin/TypeLenses.hs | 7 ------- ghcide/test/exe/Main.hs | 2 +- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index d5826fa7c5..4f7084badb 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} -- | An HLS plugin to provide code lenses for type signatures @@ -68,9 +67,6 @@ import Language.LSP.Types (ApplyWorkspaceEditParams ( TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit)) import Text.Regex.TDFA ((=~), (=~~)) -#if MIN_VERSION_ghc(9,2,0) -import GHC.Utils.Outputable (SDocContext(..), updSDocContext) -#endif typeLensCommandId :: T.Text typeLensCommandId = "typesignature.add" @@ -220,9 +216,6 @@ instance A.FromJSON Mode where showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String showDocRdrEnv env rdrEnv = showSDocForUser' env (mkPrintUnqualifiedDefault env rdrEnv) -#if MIN_VERSION_ghc(9,2,0) - . updSDocContext (\ctx -> ctx { sdocPrintExplicitKinds = False }) -#endif data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs deriving (Generic, Show, Eq, Ord, Hashable, NFData) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 74e9034b2c..7ca77ae7c0 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3828,7 +3828,7 @@ addSigLensesTests = , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, " <> listOfChar <> ")") , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"") , ("promotedKindTest = Proxy @Nothing", "promotedKindTest :: Proxy 'Nothing") - , ("typeOperatorTest = Refl", "typeOperatorTest :: a :~: a") + , ("typeOperatorTest = Refl", if ghcVersion >= GHC92 then "typeOperatorTest :: forall {k} {a :: k}. a :~: a" else "typeOperatorTest :: a :~: a") , ("notInScopeTest = mkCharType", "notInScopeTest :: String -> Data.Data.DataType") ] in testGroup From 8d3fe3bb63ed42d8d92a65efe54af85300f9a043 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 20:42:01 +0100 Subject: [PATCH 133/149] remove unnecessary? allow-newer --- cabal-ghc901.project | 1 - 1 file changed, 1 deletion(-) diff --git a/cabal-ghc901.project b/cabal-ghc901.project index 63d9fa5f6b..f813020ae7 100644 --- a/cabal-ghc901.project +++ b/cabal-ghc901.project @@ -47,7 +47,6 @@ constraints: -- although we are not building all plugins cabal solver phase is run for all packages -- this way we track explicitly all transitive dependencies which need support for ghc-9 allow-newer: - *:ghc-bignum, brittany:base, brittany:ghc, brittany:ghc-boot-th, From 8b48325e7daa2d541a3db5cdfeb5a2bee4cbf939 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 20:43:20 +0100 Subject: [PATCH 134/149] Drop no longer needed source repo for th-extras --- cabal-ghc921.project | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 7ec1603229..805bf347d5 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -34,12 +34,6 @@ source-repository-package -- To fix windows build -- https://github.com/jacobstanley/unix-compat/pull/47 -source-repository-package - type: git - location: https://github.com/Bodigrim/th-extras - tag: f00ebca78f474d271fd7989cae0a0a47559b2efd - -- https://github.com/mokus0/th-extras/pull/14 - repository head.hackage.ghc.haskell.org url: https://ghc.gitlab.haskell.org/head.hackage/ secure: True From a118b746ff37e15e9b01725da0ca92634733737e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 20:55:20 +0100 Subject: [PATCH 135/149] Add module header comments --- ghcide/src/Development/IDE/GHC/Compat.hs | 11 ++++++++--- ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs | 3 +++ 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index b1adb9b3d9..4b52ee1868 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -163,19 +163,24 @@ getMessages' pst dflags = dflags #endif --- pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a -pattern PFailedWithErrorMessages msgs #if MIN_VERSION_ghc(9,2,0) +pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a +pattern PFailedWithErrorMessages msgs <- PFailed (const . fmap pprError . getErrorMessages -> msgs) #elif MIN_VERSION_ghc(8,10,0) +pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a +pattern PFailedWithErrorMessages msgs <- PFailed (getErrorMessages -> msgs) #else +pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a +pattern PFailedWithErrorMessages msgs <- ((fmap.fmap) unitBag . mkPlainErrMsgIfPFailed -> Just msgs) -{-# COMPLETE PFailedWithErrorMessages #-} mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err) mkPlainErrMsgIfPFailed _ = Nothing #endif +{-# COMPLETE PFailedWithErrorMessages #-} + supportsHieFiles :: Bool supportsHieFiles = True diff --git a/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs index 83e92ddcba..aae6e6f4f8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/ExactPrint.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} +-- | This module contains compatibility constructs to write type signatures across +-- multiple ghc-exactprint versions, accepting that anything more ambitious is +-- pretty much impossible with the GHC 9.2 redesign of ghc-exactprint module Development.IDE.GHC.Compat.ExactPrint ( ExactPrint , exactPrint From 9b045f793bf05f4e365e60fc2597187422445780 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 21:09:35 +0100 Subject: [PATCH 136/149] Fix or remove commented out code --- ghcide/src/Development/IDE/Core/Shake.hs | 1 - ghcide/src/Development/IDE/GHC/ExactPrint.hs | 6 ++---- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 8 +++++--- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 54bd0331ea..da727cadd2 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -713,7 +713,6 @@ newSession extras@ShakeExtras{..} shakeDb acts reason = do ++ " (took " ++ showDuration runTime ++ ")" liftIO $ do logPriority logger (actionPriority d) msg - -- notifyTestingLogMessage extras msg -- The inferred type signature doesn't work in ghc >= 9.0.1 workRun :: (forall b. IO b -> IO b) -> IO (IO ()) diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index 179d959463..c54549606f 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -7,6 +7,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} +-- | This module hosts various abstractions and utility functions to work with ghc-exactprint. module Development.IDE.GHC.ExactPrint ( Graft(..), graftDecls, @@ -584,10 +585,7 @@ annotateDecl dflags ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,2,0) - expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered - -- let anns' = setPrecedingLines expr' 1 0 anns - -- modifyAnnsT $ mappend anns' - pure expr' + lift $ mapLeft show $ parseDecl dflags uniq rendered #else (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered let anns' = setPrecedingLines expr' 1 0 anns diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index d3796b0d1f..e1667ef627 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -227,7 +227,11 @@ findInstanceHead df instanceHead decls = ] #endif --- findDeclContainingLoc :: Position -> [GenLocated (SrcSpanAnn' a) e] -> Maybe (GenLocated (SrcSpanAnn' a) e) +#if MIN_VERSION_ghc(9,2,0) +findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e) +#else +-- TODO populate this type signature for GHC versions <9.2 +#endif findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- Single: @@ -889,12 +893,10 @@ data HidingMode Bool -- ^ Parenthesised? ModuleName - -- deriving (Show) data ModuleTarget = ExistingImp (NonEmpty (LImportDecl GhcPs)) | ImplicitPrelude [LImportDecl GhcPs] - -- deriving (Show) targetImports :: ModuleTarget -> [LImportDecl GhcPs] targetImports (ExistingImp ne) = NE.toList ne From 5fcab6cdf4264ad843b3eaa7b8db4635b15dc8e2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 21:11:01 +0100 Subject: [PATCH 137/149] more commented out code --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index fdc17a5170..5db4d47149 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -507,7 +507,6 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result ] doc = SpanDocText (getDocumentation [pmod] $ reLoc tcdLName) (SpanDocUris Nothing Nothing) - -- getFlds :: HsConDeclH98Details GhcPs -> Maybe [ConDeclField GhcPs] getFlds conArg = case conArg of RecCon rec -> Just $ unLoc <$> unLoc rec PrefixCon{} -> Just [] From 6c3c126a1502c6b5e13ceb2ac122e0a47d67c3be Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 22:44:17 +0100 Subject: [PATCH 138/149] Disable a couple of func-test tests --- test/functional/FunctionalCodeAction.hs | 13 +++++++------ test/functional/Main.hs | 2 +- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index cf368b0613..807963c77e 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -4,17 +4,17 @@ module FunctionalCodeAction (tests) where -import Control.Lens hiding (List) +import Control.Lens hiding (List) import Control.Monad import Data.Aeson -import qualified Data.HashMap.Strict as HM +import qualified Data.HashMap.Strict as HM import Data.List -import qualified Data.Map as M +import qualified Data.Map as M import Data.Maybe -import qualified Data.Text as T +import qualified Data.Text as T import Ide.Plugin.Config -import Language.LSP.Test as Test -import qualified Language.LSP.Types.Lens as L +import Language.LSP.Test as Test +import qualified Language.LSP.Types.Lens as L import Test.Hls import Test.Hspec.Expectations @@ -358,6 +358,7 @@ expectFailIfGhc9 :: String -> TestTree -> TestTree expectFailIfGhc9 reason = case ghcVersion of GHC90 -> expectFailBecause reason + GHC92 -> expectFailBecause reason _ -> id disableWingman :: Session () diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 93072b52ac..9cf61e05d7 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -27,7 +27,7 @@ main = defaultTestRunner , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Deferred.tests , Definition.tests , Diagnostic.tests - , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Format.tests + , ignoreInEnv [HostOS Windows, GhcVer GHC90, GhcVer GHC92] "Tests gets stuck in ci" $ Format.tests , FunctionalBadProject.tests , FunctionalCodeAction.tests , HieBios.tests From 7ab6b97ab036d76e913cf0de6910e66f5f11bc9c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 6 Jan 2022 23:04:18 +0100 Subject: [PATCH 139/149] All func-test tests passing now --- test/functional/FunctionalCodeAction.hs | 5 +++-- test/testdata/hie.yaml | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 807963c77e..51d7c8eae4 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -344,14 +344,15 @@ unusedTermTests = testGroup "unused term code actions" [ liftIO $ do let cas = map fromAction res kinds = map (^. L.kind) cas - nub kinds @?= [Just CodeActionRefactorInline, Just CodeActionRefactorExtract, Just CodeActionQuickFix] + assertBool "Test precondition failed" $ Just CodeActionQuickFix `elem` kinds -- Verify that that when we set the only parameter, we only get actions -- of the right kind. ResponseMessage _ _ (Right (List res)) <- request STextDocumentCodeAction params liftIO $ do let cas = map fromAction res kinds = map (^. L.kind) cas - nub kinds @?= nub [Just CodeActionRefactorInline, Just CodeActionRefactorExtract] + assertBool "Quick fixes should have been filtered out" + $ Just CodeActionQuickFix `notElem` kinds ] expectFailIfGhc9 :: String -> TestTree -> TestTree diff --git a/test/testdata/hie.yaml b/test/testdata/hie.yaml index 71812fbd6d..a8703fdd69 100644 --- a/test/testdata/hie.yaml +++ b/test/testdata/hie.yaml @@ -1,6 +1,7 @@ cradle: direct: arguments: + - "-Wmissing-signatures" - "CodeActionImport" - "CodeActionOnly" - "CodeActionRename" From 22cd25f3a05b7e4e85c5743ab7d2bd2e6d47ac04 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 7 Jan 2022 19:48:42 +0100 Subject: [PATCH 140/149] fix test matrix --- .github/workflows/test.yml | 6 +++--- cabal-ghc921.project | 1 + 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 8970cb936b..80f3529ab8 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -150,7 +150,7 @@ jobs: name: Test hls-brittany-plugin run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-floskell-plugin --test-options="$TEST_OPTS" @@ -158,7 +158,7 @@ jobs: name: Test hls-class-plugin run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.1' + - if: matrix.test name: Test hls-pragmas-plugin run: cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" @@ -202,7 +202,7 @@ jobs: name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.1' + - if: matrix.test name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 805bf347d5..0b96b7b94d 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -26,6 +26,7 @@ packages: -- ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin -- ./plugins/hls-alternate-number-format-plugin + ../lsp/lsp-test source-repository-package type: git From a98d36a8b54cba55456d01cdc1d938801755c928 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 8 Jan 2022 12:27:48 +0100 Subject: [PATCH 141/149] Update cabal-ghc921.project --- cabal-ghc921.project | 1 - 1 file changed, 1 deletion(-) diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 0b96b7b94d..805bf347d5 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -26,7 +26,6 @@ packages: -- ./plugins/hls-ormolu-plugin ./plugins/hls-call-hierarchy-plugin -- ./plugins/hls-alternate-number-format-plugin - ../lsp/lsp-test source-repository-package type: git From 631bc19b61ed8aeeb066d4b4ec4c4b57a739fecd Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 8 Jan 2022 17:17:49 +0100 Subject: [PATCH 142/149] do not test class plugin --- .github/workflows/test.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 80f3529ab8..19de6524b5 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -154,7 +154,7 @@ jobs: name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-floskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-class-plugin run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" From 0d74359c98907bb95e132a173144540e4c92edb6 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 9 Jan 2022 11:28:13 +0100 Subject: [PATCH 143/149] Mark hover test broken in Windows and Mac --- ghcide/test/exe/Main.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 7ca77ae7c0..3774f58e05 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -7,6 +7,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} @@ -81,7 +82,7 @@ import System.Exit (ExitCode (ExitSuccess import System.FilePath import System.IO.Extra hiding (withTempDir) import qualified System.IO.Extra -import System.Info.Extra (isWindows) +import System.Info.Extra (isWindows, isMac) import System.Mem (performGC) import System.Process.Extra (CreateProcess (cwd), createPipe, proc, @@ -4047,9 +4048,13 @@ findDefinitionAndHoverTests = let , test no skip cccL17 docLink "Haddock html links" , testM yes yes imported importedSig "Imported symbol" , testM yes yes reexported reexportedSig "Imported symbol (reexported)" - , if ghcVersion == GHC90 && isWindows then + , if | ghcVersion == GHC90 && isWindows -> test no broken thLocL57 thLoc "TH Splice Hover" - else + | ghcVersion == GHC92 && (isWindows || isMac) -> + -- Some GHC 9.2 distributions ship without .hi docs + -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903 + test no broken thLocL57 thLoc "TH Splice Hover" + | otherwise -> test no yes thLocL57 thLoc "TH Splice Hover" ] where yes, broken :: (TestTree -> Maybe TestTree) From 2c4e7eb1b9b3dde91e00aeb96b5d18c329dffb82 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 9 Jan 2022 16:57:27 +0100 Subject: [PATCH 144/149] Fix hls-pragmas-plugin test suite --- plugins/hls-pragmas-plugin/test/testdata/hie.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/plugins/hls-pragmas-plugin/test/testdata/hie.yaml b/plugins/hls-pragmas-plugin/test/testdata/hie.yaml index 1a9f518b52..7b4d912951 100644 --- a/plugins/hls-pragmas-plugin/test/testdata/hie.yaml +++ b/plugins/hls-pragmas-plugin/test/testdata/hie.yaml @@ -1,6 +1,7 @@ cradle: direct: arguments: + - "-XHaskell2010" - "NeedsPragmas" - "TypeApplications" - "NamedFieldPuns" From bfaa86e602d67000861d22d89be679aa6a1058fa Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 9 Jan 2022 23:06:35 +0100 Subject: [PATCH 145/149] disable testing of refine imports plugin --- .github/workflows/test.yml | 2 +- cabal-ghc921.project | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 19de6524b5..4f606284e5 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -190,7 +190,7 @@ jobs: name: Test hls-tactics-plugin test suite run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-refine-imports-plugin test suite run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" diff --git a/cabal-ghc921.project b/cabal-ghc921.project index 805bf347d5..ea4a41b7a4 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -13,7 +13,7 @@ packages: ./plugins/hls-class-plugin -- ./plugins/hls-eval-plugin ./plugins/hls-explicit-imports-plugin - ./plugins/hls-refine-imports-plugin + -- ./plugins/hls-refine-imports-plugin -- ./plugins/hls-hlint-plugin ./plugins/hls-rename-plugin -- ./plugins/hls-retrie-plugin From fb1d5f1d4f43dbf00f592a16505c6c8858016c90 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 10 Jan 2022 08:46:03 +0100 Subject: [PATCH 146/149] disable rename plugin --- .github/workflows/test.yml | 2 +- cabal-ghc921.project | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 4f606284e5..62b2956044 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -202,7 +202,7 @@ jobs: name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" diff --git a/cabal-ghc921.project b/cabal-ghc921.project index ea4a41b7a4..0bfb0c086e 100644 --- a/cabal-ghc921.project +++ b/cabal-ghc921.project @@ -57,7 +57,7 @@ write-ghc-environment-files: never index-state: 2022-01-03T18:45:00Z constraints: - -- These plugins doesn't work on GHC92 yet + -- These plugins don't build/work on GHC92 yet haskell-language-server +ignore-plugins-ghc-bounds -alternateNumberFormat @@ -76,7 +76,9 @@ constraints: -retrie -splice -stylishhaskell - -tactic, + -tactic + -- the rename plugin builds, but doesn't work + -rename, ghc-lib-parser ^>= 9.2, attoparsec ^>= 0.14.3, ghc-exactprint >= 1.3, From 4c52957d08f0d64b95ec30f6297ef7da96863b9f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 10 Jan 2022 12:17:24 +0100 Subject: [PATCH 147/149] Do not test qualify imported names plugin --- .github/workflows/test.yml | 2 +- .../src/Ide/Plugin/QualifyImportedNames.hs | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 62b2956044..3b6122cc61 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -214,7 +214,7 @@ jobs: name: Test hls-alternate-number-format-plugin test suite run: cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.2.1' name: Test hls-qualify-imported-names-plugin test suite run: cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index ad5f15df6c..fd2fe979c7 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -38,15 +38,17 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), ImportSpec (ImpSpec), LImportDecl, ModuleName, Name, NameEnv, OccName, - ParsedModule (ParsedModule, pm_parsed_source), - RefMap, Span, SrcSpan, + ParsedModule, RefMap, Span, + SrcSpan, TcGblEnv (tcg_rdr_env), emptyUFM, globalRdrEnvElts, gre_imp, gre_name, lookupNameEnv, moduleNameString, nameOccName, occNameString, - pattern GRE, plusUFM_C, + pattern GRE, + pattern ParsedModule, + plusUFM_C, pm_parsed_source, srcSpanEndCol, srcSpanEndLine, srcSpanStartCol, From 635bd434739c126f6d2a6cd131bf4517cc286bae Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 12 Jan 2022 13:55:50 +0200 Subject: [PATCH 148/149] addressing hlint suggestions --- ghcide/src/Development/IDE/Core/Compile.hs | 2 +- ghcide/src/Development/IDE/GHC/Dump.hs | 2 +- ghcide/src/Development/IDE/GHC/ExactPrint.hs | 1 - ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 1 - 4 files changed, 2 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 36fe1b9c66..9279abd288 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -166,7 +166,7 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do diags = map errorPipeline warnings deferedError = any fst diags case etcm of - Left errs -> return ((map snd diags) ++ errs, Nothing) + Left errs -> return (map snd diags ++ errs, Nothing) Right tcm -> return (map snd diags, Just $ tcm{tmrDeferedError = deferedError}) where demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/ghcide/src/Development/IDE/GHC/Dump.hs index 40bd97b54c..c75572ffc0 100644 --- a/ghcide/src/Development/IDE/GHC/Dump.hs +++ b/ghcide/src/Development/IDE/GHC/Dump.hs @@ -51,7 +51,7 @@ showAstDataHtml a0 = html $ #if MIN_VERSION_ghc(9,2,1) | cts == empty = foo #endif - | otherwise = foo $$ (caret $ ul cts) + = foo $$ (caret $ ul cts) body cts = tag "body" $ cts $$ tag "script" (text js) header = tag "head" $ tag "style" $ text css html = tag "html" diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index c54549606f..5d3f3e07c5 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -5,7 +5,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} -- | This module hosts various abstractions and utility functions to work with ghc-exactprint. module Development.IDE.GHC.ExactPrint diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index bfff121c1e..9810cf98d5 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} module Development.IDE.Plugin.CodeAction.ExactPrint ( From f6b79f5943a89134aaa2bb0dc6288fb14ac09f8d Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Wed, 12 Jan 2022 18:26:08 +0000 Subject: [PATCH 149/149] Revert hlint change that breaks due to CPP --- ghcide/src/Development/IDE/GHC/Dump.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/ghcide/src/Development/IDE/GHC/Dump.hs index c75572ffc0..40bd97b54c 100644 --- a/ghcide/src/Development/IDE/GHC/Dump.hs +++ b/ghcide/src/Development/IDE/GHC/Dump.hs @@ -51,7 +51,7 @@ showAstDataHtml a0 = html $ #if MIN_VERSION_ghc(9,2,1) | cts == empty = foo #endif - = foo $$ (caret $ ul cts) + | otherwise = foo $$ (caret $ ul cts) body cts = tag "body" $ cts $$ tag "script" (text js) header = tag "head" $ tag "style" $ text css html = tag "html"