From 9dd43159169eec0f222c82f25c11a36db4bfcf93 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 7 May 2024 13:51:48 +0530 Subject: [PATCH 01/21] Support for 9.10 This includes supports for all plugins, other than formatters and hlint. We need ghc-exactprint and retrie release before merging this. --- .github/workflows/supported-ghc-versions.json | 2 +- cabal.project | 67 ++++++++++++- ghcide/src/Development/IDE/Core/Compile.hs | 2 +- ghcide/src/Development/IDE/Core/RuleTypes.hs | 2 +- ghcide/src/Development/IDE/GHC/CPP.hs | 8 +- ghcide/src/Development/IDE/GHC/Compat.hs | 6 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 37 +++++++- ghcide/src/Development/IDE/GHC/Orphans.hs | 9 +- ghcide/src/Development/IDE/LSP/Outline.hs | 4 +- hie-compat/hie-compat.cabal | 2 +- hls-graph/hls-graph.cabal | 2 +- .../src/Ide/Plugin/Class/ExactPrint.hs | 14 +++ .../src/Ide/Plugin/Class/Types.hs | 4 + .../src/Ide/Plugin/ExplicitImports.hs | 4 + .../src/Ide/Plugin/ExplicitFields.hs | 16 ++++ plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs | 50 +++++++++- .../src/Ide/Plugin/OverloadedRecordDot.hs | 12 +++ .../src/Development/IDE/GHC/Dump.hs | 35 ++++++- .../src/Development/IDE/GHC/ExactPrint.hs | 80 ++++++++++++++-- .../src/Development/IDE/Plugin/CodeAction.hs | 65 +++++++++++-- .../IDE/Plugin/CodeAction/ExactPrint.hs | 95 +++++++++++++++++-- .../IDE/Plugin/Plugins/AddArgument.hs | 13 ++- .../src/Ide/Plugin/Retrie.hs | 8 ++ .../src/Ide/Plugin/Splice.hs | 11 ++- shake-bench/shake-bench.cabal | 2 + 25 files changed, 501 insertions(+), 49 deletions(-) diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index 5a59fdc0a7..387811c11b 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -[ "9.8", "9.6", "9.4" , "9.2" ] +["9.10", "9.8", "9.6", "9.4" , "9.2" ] diff --git a/cabal.project b/cabal.project index d7339b4d80..faf3be7f5b 100644 --- a/cabal.project +++ b/cabal.project @@ -7,12 +7,12 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-04-30T10:44:19Z +index-state: 2024-05-15T10:44:19Z tests: True test-show-details: direct -benchmarks: True +-- benchmarks: True write-ghc-environment-files: never @@ -40,4 +40,65 @@ constraints: -- the flag '-fopen-simd', which blocked the release 2.2.0.0. -- We want to be able to benefit from the performance optimisations -- in the future, thus: TODO: remove this flag. - bitvec -simd + bitvec -simd, + + +if impl(ghc >= 9.9) + benchmarks: False + source-repository-package + type:git + location: https://github.com/alanz/ghc-exactprint.git + tag: 68ba2b8135c275737523217a546d7b58b5c5d050 + source-repository-package + type:git + location: https://github.com/wz1000/retrie.git + tag: 7bf599856f055aefa86a6db10c12dcbc10c7130a + constraints: + lens >= 5.3.2, + haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, + allow-newer: + aeson:containers, + aeson:template-haskell, + boring:base, + co-log-core:base, + constraints-extras:base, + constraints-extras:template-haskell, + commutative-semigroups:base, + dependent-map:containers, + entropy:base, + entropy:directory, + entropy:filepath, + entropy:process, + free:template-haskell, + generically:base, + ghc-trace-events:base, + haddock-library:base, + haddock-library:containers, + hie-bios:ghc, + hiedb:base, + hiedb:ghc, + indexed-traversable:base, + indexed-traversable:containers, + indexed-traversable-instances:base, + lens:template-haskell, + lsp:containers, + lsp:lens, + lsp-test:containers, + lsp-test:lens, + lsp-types:containers, + lsp-types:lens, + lsp-types:template-haskell, + monoid-subclasses:containers, + quickcheck-instances:base, + quickcheck-instances:containers, + semialign:base, + semialign:containers, + some:base, + text-short:base, + text-short:template-haskell, + tasty-hspec:base, + these:base, + uuid-types:template-haskell, + witherable:containers, +else + benchmarks: True diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index f295e568c6..af1c97a457 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -76,7 +76,7 @@ import Development.IDE.Core.Shake import Development.IDE.Core.Tracing (withTrace) import Development.IDE.GHC.Compat hiding (loadInterface, parseHeader, parseModule, - tcRnModule, writeHieFile) + tcRnModule, writeHieFile, assert) import qualified Development.IDE.GHC.Compat as Compat import qualified Development.IDE.GHC.Compat as GHC import qualified Development.IDE.GHC.Compat.Util as Util diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 605420d3b6..5199b34f46 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -24,7 +24,7 @@ import qualified Data.Map as M import Data.Time.Clock.POSIX import Data.Typeable import Development.IDE.GHC.Compat hiding - (HieFileResult) + (HieFileResult, assert) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile import Development.IDE.GHC.Util diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 450cc702e8..b0ec869e24 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -34,6 +34,10 @@ import qualified GHC.Driver.Pipeline.Execute as Pipeline import qualified GHC.SysTools.Cpp as Pipeline #endif +#if MIN_VERSION_ghc(9,11,0) +import qualified GHC.SysTools.Tasks as Pipeline +#endif + addOptP :: String -> DynFlags -> DynFlags addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s @@ -52,7 +56,9 @@ doCpp env input_fn output_fn = #if MIN_VERSION_ghc(9,5,0) let cpp_opts = Pipeline.CppOpts { cppLinePragmas = True -#if MIN_VERSION_ghc(9,9,0) +#if MIN_VERSION_ghc(9,11,0) + , sourceCodePreprocessor = Pipeline.SCPHsCpp +#elif MIN_VERSION_ghc(9,10,0) , useHsCpp = True #else , cppUseCc = False diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 75590d0596..59b28cf637 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -334,7 +334,11 @@ myCoreToStg logger dflags ictxt return (stg_binds2, denv, cost_centre_info) - +#if MIN_VERSION_ghc(9,9,0) +reLocA :: (HasLoc (GenLocated a e), HasAnnotation b) + => GenLocated a e -> GenLocated b e +reLocA = reLoc +#endif getDependentMods :: ModIface -> [ModuleName] #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index f6ab831b72..06f798d1ff 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -197,7 +197,9 @@ module Development.IDE.GHC.Compat.Core ( pattern RealSrcLoc, SrcLoc.SrcLoc(SrcLoc.UnhelpfulLoc), BufSpan, +#if !MIN_VERSION_ghc(9,9,0) GHC.SrcAnn, +#endif SrcLoc.leftmost_smallest, SrcLoc.containsSpan, SrcLoc.mkGeneralSrcSpan, @@ -494,8 +496,11 @@ import Data.Foldable (toList) import GHC.Core.Multiplicity (scaledThing) import GHC.Data.Bag import GHC.Driver.Env -import GHC.Hs (HsModule (..), SrcSpanAnn') -import GHC.Hs.Decls hiding (FunDep) +import GHC.Hs (HsModule (..)) +#if !MIN_VERSION_ghc(9,9,0) +import GHC.Hs (SrcSpanAnn') +#endif +import GHC.Hs.Decls hiding (FunDep) import GHC.Hs.Doc import GHC.Hs.Expr import GHC.Hs.Extension @@ -651,10 +656,20 @@ instance HasSrcSpan SrcSpan where instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where getLoc = GHC.getLoc +#if MIN_VERSION_ghc(9,9,0) +instance HasSrcSpan (EpAnn a) where + getLoc = GHC.getHasLoc +#endif + +#if MIN_VERSION_ghc(9,9,0) +instance HasSrcSpan (SrcLoc.GenLocated (EpAnn ann) a) where + getLoc (L l _) = getLoc l +#else instance HasSrcSpan (SrcSpanAnn' ann) where getLoc = GHC.locA instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where getLoc (L l _) = l +#endif pattern L :: HasSrcSpan a => SrcSpan -> e -> SrcLoc.GenLocated a e pattern L l a <- GHC.L (getLoc -> l) a @@ -662,9 +677,15 @@ pattern L l a <- GHC.L (getLoc -> l) a -- This is from the old api, but it still simplifies pattern ConPatIn :: SrcLoc.Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs +#if MIN_VERSION_ghc(9,9,0) +pattern ConPatIn con args <- ConPat _ (L _ (SrcLoc.noLoc -> con)) args + where + ConPatIn con args = ConPat GHC.noAnn (GHC.noLocA $ SrcLoc.unLoc con) args +#else pattern ConPatIn con args <- ConPat EpAnnNotUsed (L _ (SrcLoc.noLoc -> con)) args where ConPatIn con args = ConPat EpAnnNotUsed (GHC.noLocA $ SrcLoc.unLoc con) args +#endif conPatDetails :: Pat p -> Maybe (HsConPatDetails p) conPatDetails (ConPat _ _ args) = Just args @@ -680,8 +701,16 @@ initObjLinker env = GHCi.initObjLinker (GHCi.hscInterp env) loadDLL :: HscEnv -> String -> IO (Maybe String) -loadDLL env = - GHCi.loadDLL (GHCi.hscInterp env) +loadDLL env str = do + res <- GHCi.loadDLL (GHCi.hscInterp env) str +#if MIN_VERSION_ghc(9,11,0) + pure $ + case res of + Left err_msg -> Just err_msg + Right _ -> Nothing +#else + pure res +#endif unload :: HscEnv -> [Linkable] -> IO () unload hsc_env linkables = diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 63f663840c..d7a85948cf 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -109,14 +109,19 @@ instance NFData ModSummary where instance Ord FastString where compare a b = if a == b then EQ else compare (fs_sbs a) (fs_sbs b) + +#if MIN_VERSION_ghc(9,9,0) +instance NFData (EpAnn a) where + rnf = rwhnf +#else instance NFData (SrcSpanAnn' a) where rnf = rwhnf +deriving instance Functor SrcSpanAnn' +#endif instance Bifunctor GenLocated where bimap f g (L l x) = L (f l) (g x) -deriving instance Functor SrcSpanAnn' - instance NFData ParsedModule where rnf = rwhnf diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 8d466a61a6..1c9d1971b3 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -271,7 +271,9 @@ hsConDeclsBinders cons get_flds_gadt :: HsConDeclGADTDetails GhcPs -> [LFieldOcc GhcPs] -#if MIN_VERSION_ghc(9,3,0) +#if MIN_VERSION_ghc(9,9,0) + get_flds_gadt (RecConGADT _ flds) = get_flds (reLoc flds) +#elif MIN_VERSION_ghc(9,3,0) get_flds_gadt (RecConGADT flds _) = get_flds (reLoc flds) #else get_flds_gadt (RecConGADT flds) = get_flds (reLoc flds) diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index aa0eb241fe..49bf9990a5 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -24,7 +24,7 @@ source-repository head library default-language: GHC2021 build-depends: - base < 4.20, array, bytestring, containers, directory, filepath, transformers + base < 4.21, array, bytestring, containers, directory, filepath, transformers build-depends: ghc >= 8.10, ghc-boot ghc-options: -Wall -Wno-name-shadowing diff --git a/hls-graph/hls-graph.cabal b/hls-graph/hls-graph.cabal index 5ac6691898..72adcc3cd1 100644 --- a/hls-graph/hls-graph.cabal +++ b/hls-graph/hls-graph.cabal @@ -136,7 +136,7 @@ test-suite tests , stm , stm-containers , tasty - , tasty-hspec + , tasty-hspec >= 1.2 , tasty-rerun build-tool-depends: hspec-discover:hspec-discover diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index 3d5f63e607..d4718766ba 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -56,8 +56,17 @@ addMethodDecls ps mDecls range withSig -- -- See the link for the original definition: -- https://hackage.haskell.org/package/ghc-9.2.1/docs/Language-Haskell-Syntax-Extension.html#t:XCClsInstDecl + addWhere :: HsDecl GhcPs -> HsDecl GhcPs addWhere instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) = case cid_ext of +#if MIN_VERSION_ghc(9,9,0) + (warnings, anns, key) -> + InstD xInstD (ClsInstD ext decl { + cid_ext = ( warnings + , AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns + , key) + }) +#else (EpAnn entry anns comments, key) -> InstD xInstD (ClsInstD ext decl { cid_ext = (EpAnn @@ -67,9 +76,14 @@ addMethodDecls ps mDecls range withSig , key) }) _ -> instd +#endif addWhere decl = decl newLine (L l e) = let dp = deltaPos 1 defaultIndent +#if MIN_VERSION_ghc(9,9,0) + in L (noAnnSrcSpanDP dp <> l) e +#else in L (noAnnSrcSpanDP (getLoc l) dp <> l) e +#endif diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index f62efd5ccc..18c9dbae26 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -133,7 +133,11 @@ data BindInfo = BindInfo getInstanceBindLensRule :: Recorder (WithPriority Log) -> Rules () getInstanceBindLensRule recorder = do defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetInstanceBindLens nfp -> runMaybeT $ do +#if MIN_VERSION_ghc(9,9,0) + tmr@(tmrRenamed -> (hs_tyclds -> tycls, _, _, _, _)) <- useMT TypeCheck nfp +#else tmr@(tmrRenamed -> (hs_tyclds -> tycls, _, _, _)) <- useMT TypeCheck nfp +#endif (InstanceBindTypeSigsResult allBinds) <- useMT GetInstanceBindTypeSigs nfp let -- declared instance methods without signatures 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 2c599b5b6b..04b0b3c3a6 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -361,7 +361,11 @@ extractMinimalImports :: extractMinimalImports hsc TcModuleResult {..} = runMaybeT $ do -- extract the original imports and the typechecking environment let tcEnv = tmrTypechecked +#if MIN_VERSION_ghc(9,9,0) + (_, imports, _, _, _) = tmrRenamed +#else (_, imports, _, _) = tmrRenamed +#endif ParsedModule {pm_parsed_source = L loc _} = tmrParsed emss = exportedModuleStrings tmrParsed Just srcSpan <- pure $ realSpan loc diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs index 75d6e06ed8..9545865efc 100644 --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -35,7 +35,11 @@ import Development.IDE.Core.RuleTypes (TcModuleResult (..), TypeCheck (..)) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat (HsConDetails (RecCon), +#if __GLASGOW_HASKELL__ < 910 HsExpansion (HsExpanded), +#else + XXExprGhcRn(..), +#endif HsExpr (XExpr), HsRecFields (..), LPat, Outputable, getLoc, @@ -176,7 +180,11 @@ collectRecordsRule recorder = toRangeAndUnique (uid, recordInfo) = (recordInfoToRange recordInfo, uid) getRecords :: TcModuleResult -> [RecordInfo] +#if __GLASGOW_HASKELL__ < 910 getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = +#else +getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_, _)) = +#endif collectRecords valBinds collectNamesRule :: Rules () @@ -187,7 +195,11 @@ collectNamesRule = defineNoDiagnostics mempty $ \CollectNames nfp -> runMaybeT $ -- | Collects all 'Name's of a given source file, to be used -- in the variable usage analysis. getNames :: TcModuleResult -> UniqFM Name [Name] +#if __GLASGOW_HASKELL__ < 910 getNames (tmrRenamed -> (group,_,_,_)) = collectNames group +#else +getNames (tmrRenamed -> (group,_,_,_,_)) = collectNames group +#endif data CollectRecords = CollectRecords deriving (Eq, Show, Generic) @@ -357,7 +369,11 @@ getRecCons :: LHsExpr (GhcPass 'Renamed) -> ([RecordInfo], Bool) -- because there is a possibility that there were be more than one result per -- branch +#if __GLASGOW_HASKELL__ >= 910 +getRecCons (unLoc -> XExpr (ExpandedThingRn a _)) = (collectRecords a, True) +#else getRecCons (unLoc -> XExpr (HsExpanded a _)) = (collectRecords a, True) +#endif getRecCons e@(unLoc -> RecordCon _ _ flds) | isJust (rec_dotdot flds) = (mkRecInfo e, False) where diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index ec19f5e8f0..453bbd8334 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -14,16 +14,26 @@ import Development.IDE import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.ExactPrint import GHC.Parser.Annotation (AddEpAnn (..), +#if MIN_VERSION_ghc(9,9,0) + EpaLocation'(..), + EpUniToken(..), + noAnn, +#else Anchor (Anchor), AnchorOperation (MovedAnchor), + EpaLocation (EpaDelta), + SrcSpanAnn' (SrcSpanAnn), +#endif DeltaPos (..), EpAnn (..), EpAnnComments (EpaComments), - EpaLocation (EpaDelta), - SrcSpanAnn' (SrcSpanAnn), spanAsAnchor) import Ide.PluginUtils (subRange) +#if MIN_VERSION_ghc(9,9,0) +import Language.Haskell.GHC.ExactPrint.Utils (showAst) +#else import Language.Haskell.GHC.ExactPrint (showAst) +#endif import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) #if MIN_VERSION_ghc(9,5,0) @@ -83,14 +93,18 @@ h98ToGADTConDecl :: h98ToGADTConDecl dataName tyVars ctxt = \case ConDeclH98{..} -> ConDeclGADT +#if MIN_VERSION_ghc(9,9,0) + (NoEpUniTok, con_ext) +#else con_ext +#endif #if MIN_VERSION_ghc(9,5,0) (NE.singleton con_name) #else [con_name] #endif -#if MIN_VERSION_ghc(9,5,0) +#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,9,0) (L NoTokenLoc HsNormalTok) #endif -- Ignore all existential type variable since GADT not needed @@ -103,9 +117,19 @@ h98ToGADTConDecl dataName tyVars ctxt = \case where -- Parameters in the data constructor renderDetails :: HsConDeclH98Details GP -> HsConDeclGADTDetails GP +#if MIN_VERSION_ghc(9,9,0) + renderDetails (PrefixCon _ args) = PrefixConGADT noExtField args +#else renderDetails (PrefixCon _ args) = PrefixConGADT args +#endif +#if MIN_VERSION_ghc(9,9,0) + renderDetails (InfixCon arg1 arg2) = PrefixConGADT noExtField [arg1, arg2] +#else renderDetails (InfixCon arg1 arg2) = PrefixConGADT [arg1, arg2] -#if MIN_VERSION_ghc(9,3,0) +#endif +#if MIN_VERSION_ghc(9,9,0) + renderDetails (RecCon recs) = RecConGADT NoEpUniTok recs +#elif MIN_VERSION_ghc(9,3,0) renderDetails (RecCon recs) = RecConGADT recs noHsUniTok #else renderDetails (RecCon recs) = RecConGADT recs @@ -196,13 +220,25 @@ prettyGADTDecl df decl = -- Make every data constructor start with a new line and 2 spaces adjustCon :: LConDecl GP -> LConDecl GP +#if MIN_VERSION_ghc(9,9,0) + adjustCon (L ann r) = + L (EpAnn (go (spanAsAnchor (getLoc ann))) (AnnListItem []) (EpaComments [])) r +#else adjustCon (L (SrcSpanAnn _ loc) r) = L (SrcSpanAnn (EpAnn (go (spanAsAnchor loc)) (AnnListItem []) (EpaComments [])) loc) r +#endif where +#if MIN_VERSION_ghc(9,9,0) + go _ = EpaDelta (DifferentLine 1 2) [] +#else go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2)) +#endif -- Adjust where annotation to the same line of the type constructor - adjustWhere tcdDExt = tcdDExt <&> map + adjustWhere tcdDExt = tcdDExt <&> +#if !MIN_VERSION_ghc(9,9,0) + map +#endif (\(AddEpAnn ann l) -> if ann == AnnWhere then AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) @@ -220,7 +256,11 @@ wrapCtxt = id emptyCtxt = Nothing unWrap = unXRec @GP mapX = mapXRec @GP +#if MIN_VERSION_ghc(9,9,0) +noUsed = noAnn +#else noUsed = EpAnnNotUsed +#endif pattern UserTyVar' :: LIdP pass -> HsTyVarBndr flag pass pattern UserTyVar' s <- UserTyVar _ _ s diff --git a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs index 03b62b4a5b..e7e365ac24 100644 --- a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs +++ b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs @@ -48,7 +48,11 @@ import Development.IDE.Core.PositionMapping (PositionMapping, toCurrentRange) import Development.IDE.GHC.Compat (Extension (OverloadedRecordDot), GhcPass, +#if __GLASGOW_HASKELL__ < 910 HsExpansion (HsExpanded), +#else + XXExprGhcRn(..), +#endif HsExpr (HsApp, HsVar, OpApp, XExpr), LHsExpr, Pass (..), appPrec, dollarName, @@ -246,7 +250,11 @@ collectRecSelsRule recorder = define (cmapWithPrio LogShake recorder) $ where getEnabledExtensions :: TcModuleResult -> [Extension] getEnabledExtensions = getExtensions . tmrParsed getRecordSelectors :: TcModuleResult -> [RecordSelectorExpr] +#if __GLASGOW_HASKELL__ >= 910 + getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_,_)) = +#else getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = +#endif collectRecordSelectors valBinds rewriteRange :: PositionMapping -> RecordSelectorExpr -> Maybe RecordSelectorExpr @@ -281,7 +289,11 @@ getRecSels :: LHsExpr (GhcPass 'Renamed) -> ([RecordSelectorExpr], Bool) -- branch. We do this here, by explicitly returning occurrences from traversing -- the original branch, and returning True, which keeps syb from implicitly -- continuing to traverse. +#if __GLASGOW_HASKELL__ >= 910 +getRecSels (unLoc -> XExpr (ExpandedThingRn a _)) = (collectRecordSelectors a, True) +#else getRecSels (unLoc -> XExpr (HsExpanded a _)) = (collectRecordSelectors a, True) +#endif #if __GLASGOW_HASKELL__ >= 903 -- applied record selection: "selector record" or "selector (record)" or -- "selector selector2.record2" diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index 93da3ba76f..f015ea7658 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -61,7 +61,9 @@ showAstDataHtml a0 = html $ `extQ` sourceText `extQ` deltaPos `extQ` epaAnchor +#if !MIN_VERSION_ghc(9,9,0) `extQ` anchorOp +#endif `extQ` bytestring `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon @@ -129,16 +131,20 @@ showAstDataHtml a0 = html $ #endif epaAnchor :: EpaLocation -> SDoc -#if MIN_VERSION_ghc(9,5,0) +#if MIN_VERSION_ghc(9,9,0) + epaAnchor (EpaSpan s) = parens $ text "EpaSpan" <+> srcSpan s +#elif MIN_VERSION_ghc(9,5,0) epaAnchor (EpaSpan r _) = text "EpaSpan" <+> realSrcSpan r #else epaAnchor (EpaSpan r) = text "EpaSpan" <+> realSrcSpan r #endif epaAnchor (EpaDelta d cs) = text "EpaDelta" <+> deltaPos d <+> showAstDataHtml' cs +#if !MIN_VERSION_ghc(9,9,0) anchorOp :: AnchorOperation -> SDoc anchorOp UnchangedAnchor = "UnchangedAnchor" anchorOp (MovedAnchor dp) = "MovedAnchor " <> deltaPos dp +#endif deltaPos :: DeltaPos -> SDoc deltaPos (SameLine c) = text "SameLine" <+> ppr c @@ -249,6 +255,32 @@ showAstDataHtml a0 = html $ -- ------------------------- +#if MIN_VERSION_ghc(9,9,0) + srcSpanAnnA :: EpAnn AnnListItem -> SDoc + srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA") + + srcSpanAnnL :: EpAnn AnnList -> SDoc + srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL") + + srcSpanAnnP :: EpAnn AnnPragma -> SDoc + srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP") + + srcSpanAnnC :: EpAnn AnnContext -> SDoc + srcSpanAnnC = locatedAnn'' (text "SrcSpanAnnC") + + srcSpanAnnN :: EpAnn NameAnn -> SDoc + srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN") + + locatedAnn'' :: forall a. (Typeable a, Data a) + => SDoc -> EpAnn a -> SDoc + locatedAnn'' tag ss = parens $ + case cast ss of + Just (ann :: EpAnn a) -> + text (showConstr (toConstr ann)) + $$ vcat (gmapQ showAstDataHtml' ann) + Nothing -> text "locatedAnn:unmatched" <+> tag + <+> (parens $ text (showConstr (toConstr ss))) +#else srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA") @@ -274,6 +306,7 @@ showAstDataHtml a0 = html $ $$ li(srcSpan s)) Nothing -> text "locatedAnn:unmatched" <+> tag <+> text (showConstr (toConstr ss)) +#endif normalize_newlines :: String -> String diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index cd91743756..2420665215 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -30,7 +30,6 @@ module Development.IDE.GHC.ExactPrint removeComma, -- * Helper function eqSrcSpan, - eqSrcSpanA, epl, epAnn, removeTrailingComma, @@ -106,13 +105,31 @@ import Control.Lens (_last, (&)) import Control.Lens.Operators ((%~)) import Data.List (partition) import GHC (Anchor (..), +#if MIN_VERSION_ghc(9,9,0) + EpAnn(..), + EpaLocation(..), + AnnContext(..), + SrcSpanAnnA, + NameAnn(..), + TrailingAnn(..), + deltaPos, + EpaLocation'(..), + spanAsAnchor, + emptyComments, + NameAdornment(..), +#else AnchorOperation, +#endif DeltaPos (..), SrcSpanAnnN, realSrcSpan) import GHC.Types.SrcLoc (generatedSrcSpan) -setPrecedingLines :: Default t => LocatedAn t a -> Int -> Int -> LocatedAn t a +setPrecedingLines :: +#if !MIN_VERSION_ghc(9,9,0) + Default t => +#endif + LocatedAn t a -> Int -> Int -> LocatedAn t a setPrecedingLines ast n c = setEntryDP ast (deltaPos n c) ------------------------------------------------------------------------------ @@ -232,7 +249,9 @@ needsParensSpace :: -- | (Needs parens, needs space) (All, All) needsParensSpace HsLam{} = (All False, All False) +#if !MIN_VERSION_ghc(9,9,0) needsParensSpace HsLamCase{} = (All False, All True) +#endif needsParensSpace HsApp{} = mempty needsParensSpace HsAppType{} = mempty needsParensSpace OpApp{} = mempty @@ -440,18 +459,34 @@ modifySmallestDeclWithM validSpan f a = do False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a +#if MIN_VERSION_ghc(9,9,0) +generatedAnchor :: DeltaPos -> Anchor +generatedAnchor dp = EpaDelta dp [] +#else generatedAnchor :: AnchorOperation -> Anchor generatedAnchor anchorOp = GHC.Anchor (GHC.realSrcSpan generatedSrcSpan) anchorOp +#endif setAnchor :: Anchor -> SrcSpanAnnN -> SrcSpanAnnN +#if MIN_VERSION_ghc(9,9,0) +setAnchor anc (EpAnn _ nameAnn comments) = + EpAnn anc nameAnn comments +#else setAnchor anc (SrcSpanAnn (EpAnn _ nameAnn comments) span) = SrcSpanAnn (EpAnn anc nameAnn comments) span +#endif setAnchor _ spanAnnN = spanAnnN removeTrailingAnns :: SrcSpanAnnN -> SrcSpanAnnN +#if MIN_VERSION_ghc(9,9,0) +removeTrailingAnns (EpAnn anc nameAnn comments) = + let nameAnnSansTrailings = nameAnn {nann_trailing = []} + in EpAnn anc nameAnnSansTrailings comments +#else removeTrailingAnns (SrcSpanAnn (EpAnn anc nameAnn comments) span) = let nameAnnSansTrailings = nameAnn {nann_trailing = []} in SrcSpanAnn (EpAnn anc nameAnnSansTrailings comments) span +#endif removeTrailingAnns spanAnnN = spanAnnN -- | Modify the type signature for the given IdP. This function handles splitting a multi-sig @@ -490,15 +525,28 @@ modifySigWithM queryId f a = do let matchedId' = L (setAnchor genAnchor0 $ removeTrailingAnns annMatchedId) matchedId matchedIdSig = let sig' = SigD xsig (TypeSig xTypeSig [matchedId'] (HsWC xHsWc newSig)) - epAnn = bool (noAnnSrcSpanDP generatedSrcSpan (DifferentLine 1 0)) annSigD (null otherIds) + epAnn = bool (noAnnSrcSpanDP +#if !MIN_VERSION_ghc(9,9,0) + generatedSrcSpan +#endif + (DifferentLine 1 0)) + annSigD (null otherIds) in L epAnn sig' otherSig = case otherIds of [] -> [] +#if MIN_VERSION_ghc(9,9,0) + (L epAnn id1:ids) -> [ +#else (L (SrcSpanAnn epAnn span) id1:ids) -> [ +#endif let epAnn' = case epAnn of EpAnn _ nameAnn commentsId1 -> EpAnn genAnchor0 nameAnn commentsId1 +#if MIN_VERSION_ghc(9,9,0) + ids' = L epAnn' id1:ids +#else EpAnnNotUsed -> EpAnn genAnchor0 mempty emptyComments ids' = L (SrcSpanAnn epAnn' span) id1:ids +#endif ids'' = ids' & _last %~ first removeTrailingAnns in L annSigD (SigD xsig (TypeSig xTypeSig ids'' (HsWC xHsWc lHsSig))) ] @@ -513,6 +561,13 @@ genAnchor0 = generatedAnchor m0 genAnchor1 :: Anchor genAnchor1 = generatedAnchor m1 +#if MIN_VERSION_ghc(9,9,0) +m0, m1 :: DeltaPos +m0 = SameLine 0 +m1 = SameLine 1 +#endif + + -- | Apply a transformation to the decls contained in @t@ modifyDeclsT' :: (HasDecls t, HasTransform m) => ([LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)) @@ -596,7 +651,9 @@ class , Typeable l , Outputable l , Outputable ast +#if !MIN_VERSION_ghc(9,9,0) , Default l +#endif ) => ASTElement l ast | ast -> l where parseAST :: Parser (LocatedAn l ast) maybeParensAST :: LocatedAn l ast -> LocatedAn l ast @@ -690,11 +747,6 @@ parenthesize = parenthesizeHsExpr appPrec eqSrcSpan :: SrcSpan -> SrcSpan -> Bool eqSrcSpan l r = leftmost_smallest l r == EQ --- | Equality on SrcSpan's. --- Ignores the (Maybe BufSpan) field of SrcSpan's. -eqSrcSpanA :: SrcAnn a -> SrcAnn b -> Bool -eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ - addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext addParensToCtxt close_dp = addOpen . addClose where @@ -712,15 +764,27 @@ epAnn :: SrcSpan -> ann -> EpAnn ann epAnn srcSpan anns = EpAnn (spanAsAnchor srcSpan) anns emptyComments modifyAnns :: LocatedAn a ast -> (a -> a) -> LocatedAn a ast +#if MIN_VERSION_ghc(9,9,0) +modifyAnns x f = first (fmap f) x +#else modifyAnns x f = first ((fmap.fmap) f) x +#endif removeComma :: SrcSpanAnnA -> SrcSpanAnnA +#if MIN_VERSION_ghc(9,9,0) +removeComma (EpAnn anc (AnnListItem as) cs) + = EpAnn anc (AnnListItem (filter (not . isCommaAnn) as)) cs + where + isCommaAnn AddCommaAnn{} = True + isCommaAnn _ = False +#else 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 addParens :: Bool -> GHC.NameAnn -> GHC.NameAnn addParens True it@NameAnn{} = diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 5c25c5f960..2a6c96f002 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -67,9 +67,17 @@ import Development.IDE.Plugin.TypeLenses (suggestSigna import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options +#if MIN_VERSION_ghc(9,9,0) +import GHC.Types.SrcLoc (srcSpanToRealSrcSpan) +#endif import GHC (AddEpAnn (AddEpAnn), +#if MIN_VERSION_ghc(9,9,0) + HasLoc(..), + EpaLocation'(..), +#else Anchor (anchor_op), AnchorOperation (..), +#endif AnnsModule (am_main), DeltaPos (..), EpAnn (..), @@ -253,7 +261,7 @@ isWantedModule wantedModule (Just qual) (L _ ImportDecl{ ideclAs, ideclName , ideclHiding = Just (False, _) #endif }) = - unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc . reLoc <$> ideclAs) == Just qual) + unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc <$> ideclAs) == Just qual) isWantedModule _ _ _ = False @@ -307,7 +315,7 @@ findSigOfBind range bind = findSigOfExpr :: HsExpr p -> Maybe (Sig p) findSigOfExpr = go where -#if MIN_VERSION_ghc(9,3,0) +#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,9,0) go (HsLet _ _ binds _ _) = findSigOfBinds range binds #else go (HsLet _ binds _) = findSigOfBinds range binds @@ -338,7 +346,11 @@ findInstanceHead df instanceHead decls = showSDoc df (ppr hsib_body) == instanceHead ] +#if MIN_VERSION_ghc(9,9,0) +findDeclContainingLoc :: (Foldable t, HasLoc l) => Position -> t (GenLocated l e) -> Maybe (GenLocated l e) +#else findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e) +#endif findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- Single: @@ -537,7 +549,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 $ reLoc export + , Just exportRange <- getLocatedRange $ export , exports <- unLoc export , Just (removeFromExport, !ranges) <- fmap (getRanges exports . notInScope) (extractNotInScopeName msg) <|> (,[_range]) <$> matchExportItem msg @@ -608,16 +620,16 @@ suggestDeleteUnusedBinding let maybeIdx = findIndex (\(L _ id) -> isSameName id name) lnames in case maybeIdx of Nothing -> Nothing - Just _ | [lname] <- lnames -> Just (getLoc $ reLoc lname, True) + Just _ | [lname] <- lnames -> Just (getLoc lname, True) Just idx -> - let targetLname = getLoc $ reLoc $ lnames !! idx + let targetLname = getLoc $ lnames !! idx startLoc = srcSpanStart targetLname endLoc = srcSpanEnd targetLname startLoc' = if idx == 0 then startLoc - else srcSpanEnd . getLoc . reLoc $ lnames !! (idx - 1) + else srcSpanEnd . getLoc $ lnames !! (idx - 1) endLoc' = if idx == 0 && idx < length lnames - 1 - then srcSpanStart . getLoc . reLoc $ lnames !! (idx + 1) + then srcSpanStart . getLoc $ lnames !! (idx + 1) else endLoc in Just (mkSrcSpan startLoc' endLoc', False) findRelatedSigSpan1 _ _ = Nothing @@ -1613,7 +1625,7 @@ newImportInsertRange ps fileContents | Just ((l, c), col) <- case hsmodImports of -- When there is no existing imports, we only cares about the line number, setting column and indent to zero. [] -> (\line -> ((line, 0), 0)) <$> findPositionNoImports ps fileContents - _ -> findPositionFromImports (map reLoc hsmodImports) last + _ -> findPositionFromImports hsmodImports last , let insertPos = Position (fromIntegral l) (fromIntegral c) = Just (Range insertPos insertPos, col) | otherwise = Nothing @@ -1663,12 +1675,17 @@ findPositionAfterModuleName ps hsmodName' = do -- Find the first 'where' whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule epaLocationToLine whereLocation +#if !MIN_VERSION_ghc(9,9,0) EpAnnNotUsed -> Nothing +#endif filterWhere (AddEpAnn AnnWhere loc) = Just loc filterWhere _ = Nothing epaLocationToLine :: EpaLocation -> Maybe Int -#if MIN_VERSION_ghc(9,5,0) +#if MIN_VERSION_ghc(9,9,0) + epaLocationToLine (EpaSpan sp) + = fmap (srcLocLine . realSrcSpanEnd) $ srcSpanToRealSrcSpan sp +#elif MIN_VERSION_ghc(9,5,0) epaLocationToLine (EpaSpan sp _) = Just . srcLocLine . realSrcSpanEnd $ sp #else @@ -1682,12 +1699,23 @@ findPositionAfterModuleName ps hsmodName' = do epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments) sumCommentsOffset :: [LEpaComment] -> Int +#if MIN_VERSION_ghc(9,9,0) + sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine anchor) +#else sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor)) +#endif +#if MIN_VERSION_ghc(9,9,0) + anchorOpLine :: EpaLocation' a -> Int + anchorOpLine EpaSpan{} = 0 + anchorOpLine (EpaDelta (SameLine _) _) = 0 + anchorOpLine (EpaDelta (DifferentLine line _) _) = line +#else anchorOpLine :: AnchorOperation -> Int anchorOpLine UnchangedAnchor = 0 anchorOpLine (MovedAnchor (SameLine _)) = 0 anchorOpLine (MovedAnchor (DifferentLine line _)) = line +#endif findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) findPositionFromImports hsField f = case getLoc (f hsField) of @@ -1936,22 +1964,39 @@ smallerRangesForBindingExport lies b = where unqualify = snd . breakOnEnd "." b' = wrapOperatorInParens . unqualify $ b +#if MIN_VERSION_ghc(9,9,0) + ranges' (L _ (IEThingWith _ thing _ inners _)) +#else ranges' (L _ (IEThingWith _ thing _ inners)) +#endif | T.unpack (printOutputable thing) == b' = [] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] ranges' _ = [] rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan] +#if MIN_VERSION_ghc(9,9,0) +rangesForBinding' b (L (locA -> l) (IEVar _ nm _)) +#else rangesForBinding' b (L (locA -> l) (IEVar _ nm)) +#endif | L _ (IEPattern _ (L _ b')) <- nm , T.unpack (printOutputable b') == b = [l] rangesForBinding' b (L (locA -> l) x@IEVar{}) | T.unpack (printOutputable x) == b = [l] rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | T.unpack (printOutputable x) == b = [l] -rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | T.unpack (printOutputable x) == b = [l] +#if MIN_VERSION_ghc(9,9,0) +rangesForBinding' b (L (locA -> l) (IEThingAll _ x _)) +#else +rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) +#endif + | T.unpack (printOutputable x) == b = [l] +#if MIN_VERSION_ghc(9,9,0) +rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _ inners _)) +#else rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _ inners)) +#endif | T.unpack (printOutputable thing) == b = [l] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b] diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index a9d5c48cc1..b1f946ba61 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -45,11 +45,17 @@ import GHC (AddEpAnn (..), AnnParen (..), DeltaPos (SameLine), EpAnn (..), - EpaLocation (EpaDelta), +#if !MIN_VERSION_ghc(9,9,0) + EpaLocation(EpaDelta), + ann, +#else + EpaLocation'(..), + NoAnn(..), +#endif IsUnicodeSyntax (NormalSyntax), NameAdornment (NameParens), TrailingAnn (AddCommaAnn), - addAnns, ann, + addAnns, emptyComments, reAnnL) @@ -69,9 +75,15 @@ data Rewrite where ------------------------------------------------------------------------------ class ResetEntryDP ann where resetEntryDP :: GenLocated ann ast -> GenLocated ann ast +#if MIN_VERSION_ghc(9,9,0) +instance {-# OVERLAPPING #-} NoAnn an => ResetEntryDP (EpAnn an) where + -- resetEntryDP = flip setEntryDP (SameLine 0) + resetEntryDP (L srcAnn x) = setEntryDP (L srcAnn{anns=noAnn} x) (SameLine 0) +#else 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) +#endif instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where resetEntryDP = id @@ -161,11 +173,19 @@ appendConstraint constraintT = go . traceAst "appendConstraint" #endif constraint <- liftParseAST df constraintT constraint <- pure $ setEntryDP constraint (SameLine 1) +#if MIN_VERSION_ghc(9,9,0) + let l'' = fmap (addParensToCtxt close_dp) l' +#else let l'' = (fmap.fmap) (addParensToCtxt close_dp) l' +#endif -- 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 +#if MIN_VERSION_ghc(9,9,0) + [L _ (HsParTy AnnParen{ap_close} _)] -> Just ap_close +#else [L _ (HsParTy EpAnn{anns=AnnParen{ap_close}} _)] -> Just ap_close +#endif _ -> Nothing ctxt' = over _last (first addComma) $ map dropHsParTy ctxt #if MIN_VERSION_ghc(9,4,0) @@ -259,6 +279,9 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) noExtField #endif lie +#if MIN_VERSION_ghc(9,9,0) + Nothing +#endif if x `elem` lies then TransformT $ lift (Left $ thing <> " already imported") @@ -304,9 +327,17 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies #endif where +#if MIN_VERSION_ghc(9,9,0) + go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie) _)) : _xs) +#else go _hide _l' _pre ((L _ll' (IEThingAll _ (L _ ie))) : _xs) +#endif | parent == unIEWrappedName ie = TransformT $ lift . Left $ child <> " already included in " <> parent <> " imports" +#if MIN_VERSION_ghc(9,9,0) + go hide l' pre ((L ll' (IEThingAbs _ absIE@(L _ ie) docs)) : xs) +#else go hide l' pre ((L ll' (IEThingAbs _ absIE@(L _ ie))) : xs) +#endif -- ThingAbs ie => ThingWith ie child | parent == unIEWrappedName ie = do srcChild <- uniqueSrcSpanT @@ -317,12 +348,18 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) #endif childRdr x :: LIE GhcPs = L ll' $ IEThingWith -#if MIN_VERSION_ghc(9,7,0) +#if MIN_VERSION_ghc(9,9,0) + (Nothing, [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP noAnn]) +#elif MIN_VERSION_ghc(9,7,0) (Nothing, addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) #else (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) #endif absIE NoIEWildcard [childLIE] +#if MIN_VERSION_ghc(9,9,0) + docs +#endif + #if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} @@ -330,7 +367,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} #endif +#if MIN_VERSION_ghc(9,9,0) + go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies' docs)) : xs) +#else go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs) +#endif -- ThingWith ie lies' => ThingWith ie (lies' ++ [child]) | parent == unIEWrappedName ie , child == wildCardSymbol = do @@ -340,7 +381,10 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) let it' = it{ideclHiding = Just (hide, lies)} #endif thing = IEThingWith newl twIE (IEWildcard 2) [] -#if MIN_VERSION_ghc(9,7,0) +#if MIN_VERSION_ghc(9,9,0) + docs +#endif +#if MIN_VERSION_ghc(9,7,0) && !MIN_VERSION_ghc(9,9,0) newl = fmap (\ann -> ann ++ [AddEpAnn AnnDotdot d0]) <$> l''' #else newl = (\ann -> ann ++ [AddEpAnn AnnDotdot d0]) <$> l''' @@ -369,7 +413,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) let it' = it{ideclHiding = Just (hide, lies)} #endif lies = L l' $ reverse pre ++ - [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs + [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]) +#if MIN_VERSION_ghc(9,9,0) + docs +#endif + )] ++ xs fixLast = if hasSibling then first addComma else id return $ L l it' go hide l' pre (x : xs) = go hide l' (x : pre) xs @@ -395,12 +443,17 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) noExtField #endif childRdr -#if MIN_VERSION_ghc(9,7,0) +#if MIN_VERSION_ghc(9,9,0) + listAnn = (Nothing, [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]) +#elif MIN_VERSION_ghc(9,7,0) listAnn = (Nothing, epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]) #else listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)] #endif x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE] +#if MIN_VERSION_ghc(9,9,0) + Nothing -- TODO preserve docs? +#endif lies' = addCommaInImportList (reverse pre) x #if MIN_VERSION_ghc(9,5,0) @@ -427,7 +480,11 @@ addCommaInImportList lies x = -- check if there is an existing trailing comma existingTrailingComma = fromMaybe False $ do L lastItemSrcAnn _ <- lastMaybe lies +#if MIN_VERSION_ghc(9,9,0) + lastItemAnn <- case lastItemSrcAnn of +#else lastItemAnn <- case ann lastItemSrcAnn of +#endif EpAnn _ lastItemAnn _ -> pure lastItemAnn _ -> Nothing pure $ any isTrailingAnnComma (lann_trailing lastItemAnn) @@ -483,8 +540,16 @@ extendHiding symbol (L l idecls) mlies df = do L l' lies <- case mlies of Nothing -> do src <- uniqueSrcSpanT +#if MIN_VERSION_ghc(9,9,0) + let ann = noAnnSrcSpanDP0 +#else let ann = noAnnSrcSpanDP0 src +#endif +#if MIN_VERSION_ghc(9,9,0) + ann' = flip fmap ann $ \x -> x +#else ann' = flip (fmap.fmap) ann $ \x -> x +#endif {al_rest = [AddEpAnn AnnHiding (epl 1)] ,al_open = Just $ AddEpAnn AnnOpenP (epl 1) ,al_close = Just $ AddEpAnn AnnCloseP (epl 0) @@ -508,6 +573,9 @@ extendHiding symbol (L l idecls) mlies df = do noExtField #endif lie +#if MIN_VERSION_ghc(9,9,0) + Nothing +#endif x <- pure $ if hasSibling then first addComma x else x lies <- pure $ over _head (`setEntryDP` SameLine 1) lies #if MIN_VERSION_ghc(9,5,0) @@ -541,13 +609,25 @@ deleteFromImport (T.pack -> symbol) (L l idecl) (L lieLoc lies) _ = do over _last removeTrailingComma $ mapMaybe killLie lies killLie :: LIE GhcPs -> Maybe (LIE GhcPs) +#if MIN_VERSION_ghc(9,9,0) + killLie v@(L _ (IEVar _ (L _ (unqualIEWrapName -> nam)) _)) +#else killLie v@(L _ (IEVar _ (L _ (unqualIEWrapName -> nam)))) +#endif | nam == symbol = Nothing | otherwise = Just v +#if MIN_VERSION_ghc(9,9,0) + killLie v@(L _ (IEThingAbs _ (L _ (unqualIEWrapName -> nam)) _)) +#else killLie v@(L _ (IEThingAbs _ (L _ (unqualIEWrapName -> nam)))) +#endif | nam == symbol = Nothing | otherwise = Just v +#if MIN_VERSION_ghc(9,9,0) + killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons docs)) +#else killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons)) +#endif | nam == symbol = Nothing | otherwise = Just $ @@ -557,4 +637,7 @@ deleteFromImport (T.pack -> symbol) (L l idecl) (L lieLoc lies) _ = do ty wild (filter ((/= symbol) . unqualIEWrapName . unLoc) cons) +#if MIN_VERSION_ghc(9,9,0) + docs +#endif killLie v = Just v diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs index 17488b44a7..440b17f57d 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -16,7 +16,11 @@ import Development.IDE.GHC.ExactPrint (genAnchor1, modifySmallestDeclWithM) import Development.IDE.Plugin.Plugins.Diagnostic import GHC (EpAnn (..), +#if MIN_VERSION_ghc(9,9,0) + EpUniToken(..), +#else SrcSpanAnn' (SrcSpanAnn), +#endif SrcSpanAnnA, SrcSpanAnnN, emptyComments, @@ -67,7 +71,11 @@ plugin parsedModule Diagnostic {_message, _range} addArgToMatch :: T.Text -> GenLocated l (Match GhcPs body) -> (GenLocated l (Match GhcPs body), Int) addArgToMatch name (L locMatch (Match xMatch ctxMatch pats rhs)) = let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name +#if MIN_VERSION_ghc(9,9,0) + newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField (noLocA unqualName) +#else newPat = L (noAnnSrcSpanDP1 generatedSrcSpan) $ VarPat NoExtField (noLocA unqualName) +#endif in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) rhs), Prelude.length pats) -- Attempt to insert a binding pattern into each match for the given LHsDecl; succeeds only if the function is a FunBind. @@ -139,7 +147,10 @@ hsTypeFromFunTypeAsList (args, res) = addTyHoleToTySigArg :: Int -> LHsSigType GhcPs -> (LHsSigType GhcPs) addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) = let (args, res) = hsTypeToFunTypeAsList lsigTy -#if MIN_VERSION_ghc(9,4,0) +#if MIN_VERSION_ghc(9,9,0) + wildCardAnn = EpAnn genAnchor1 (AnnListItem []) emptyComments + newArg = (noAnn, noExtField, HsUnrestrictedArrow NoEpUniTok, L wildCardAnn $ HsWildCardTy noExtField) +#elif MIN_VERSION_ghc(9,4,0) wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem []) emptyComments) generatedSrcSpan arrowAnn = TokenLoc (epl 1) newArg = (SrcSpanAnn mempty generatedSrcSpan, noAnn, HsUnrestrictedArrow (L arrowAnn HsNormalTok), L wildCardAnn $ HsWildCardTy noExtField) diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 48d2886ff0..34b92a68cc 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -349,7 +349,11 @@ getBinds nfp = do -- so that we can include adding the required imports in the retrie command let rn = tmrRenamed tm case rn of +#if MIN_VERSION_ghc(9,9,0) + (HsGroup{hs_valds, hs_ruleds, hs_tyclds}, _, _, _, _) -> do +#else (HsGroup{hs_valds, hs_ruleds, hs_tyclds}, _, _, _) -> do +#endif topLevelBinds <- case hs_valds of ValBinds{} -> throwError $ PluginInternalError "getBinds: ValBinds not supported" XValBindsLR (GHC.NValBinds binds _sigs :: GHC.NHsValBindsLR GhcRn) -> @@ -744,7 +748,11 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} #if MIN_VERSION_ghc(9,5,0) ideclImportList = Nothing ideclExt = GHCGHC.XImportDeclPass +#if MIN_VERSION_ghc(9,9,0) + { ideclAnn = GHCGHC.noAnn +#else { ideclAnn = GHCGHC.EpAnnNotUsed +#endif , ideclSourceText = ideclSourceSrc , ideclImplicit = ideclImplicit } diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index a756fd301e..9ec752ac51 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -41,7 +41,7 @@ import Data.Maybe (fromMaybe, listToMaybe, import qualified Data.Text as T import Development.IDE import Development.IDE.Core.PluginUtils -import Development.IDE.GHC.Compat as Compat hiding (getLoc) +import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.ExactPrint import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint @@ -56,7 +56,11 @@ import GHC.Data.Bag (Bag) import GHC.Exts +#if MIN_VERSION_ghc(9,9,0) +import GHC.Parser.Annotation (EpAnn(..)) +#else import GHC.Parser.Annotation (SrcSpanAnn'(..)) +#endif import qualified GHC.Types.Error as Error @@ -273,8 +277,13 @@ adjustToRange uri ran (WorkspaceEdit mhult mlt x) = -- `GenLocated`. In GHC >= 9.2 this will be a SrcSpanAnn', with annotations; -- earlier it will just be a plain `SrcSpan`. {-# COMPLETE AsSrcSpan #-} +#if MIN_VERSION_ghc(9,9,0) +pattern AsSrcSpan :: SrcSpan -> EpAnn ann +pattern AsSrcSpan locA <- (getLoc -> locA) +#else pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a pattern AsSrcSpan locA <- SrcSpanAnn {locA} +#endif findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)] findSubSpansDesc srcSpan = diff --git a/shake-bench/shake-bench.cabal b/shake-bench/shake-bench.cabal index eccd84edeb..d5852a6310 100644 --- a/shake-bench/shake-bench.cabal +++ b/shake-bench/shake-bench.cabal @@ -16,6 +16,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.10) + buildable: False exposed-modules: Development.Benchmark.Rules hs-source-dirs: src build-depends: From 68182172910debd6583e26911c5cf72da8111f8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 11:54:56 +0200 Subject: [PATCH 02/21] Remove indexed-traversable allow-newer --- cabal.project | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/cabal.project b/cabal.project index faf3be7f5b..52d17c1d4e 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-15T10:44:19Z +index-state: 2024-05-16T08:02:44Z tests: True test-show-details: direct @@ -53,7 +53,7 @@ if impl(ghc >= 9.9) type:git location: https://github.com/wz1000/retrie.git tag: 7bf599856f055aefa86a6db10c12dcbc10c7130a - constraints: + constraints: lens >= 5.3.2, haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, allow-newer: @@ -77,9 +77,6 @@ if impl(ghc >= 9.9) hie-bios:ghc, hiedb:base, hiedb:ghc, - indexed-traversable:base, - indexed-traversable:containers, - indexed-traversable-instances:base, lens:template-haskell, lsp:containers, lsp:lens, From d188e464c0503134f1a0abcab48975f6c7a0473f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 13:36:31 +0200 Subject: [PATCH 03/21] Fix couple of warnings --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 10 +- .../IDE/Graph/Internal/Database.hs | 8 +- .../src/Ide/Plugin/Splice.hs | 105 +++++++++--------- 3 files changed, 65 insertions(+), 58 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 5199b34f46..3d60669f5c 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -16,7 +16,7 @@ module Development.IDE.Core.RuleTypes( ) where import Control.DeepSeq -import Control.Exception (assert) +import qualified Control.Exception as E import Control.Lens import Data.Aeson.Types (Value) import Data.Hashable @@ -24,7 +24,7 @@ import qualified Data.Map as M import Data.Time.Clock.POSIX import Data.Typeable import Development.IDE.GHC.Compat hiding - (HieFileResult, assert) + (HieFileResult) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile import Development.IDE.GHC.Util @@ -188,9 +188,9 @@ hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> maybe "" snd hirCoreFp mkHiFileResult :: ModSummary -> ModIface -> ModDetails -> ModuleEnv ByteString -> Maybe (CoreFile, ByteString) -> HiFileResult mkHiFileResult hirModSummary hirModIface hirModDetails hirRuntimeModules hirCoreFp = - assert (case hirCoreFp of Just (CoreFile{cf_iface_hash}, _) - -> getModuleHash hirModIface == cf_iface_hash - _ -> True) + E.assert (case hirCoreFp of + Just (CoreFile{cf_iface_hash}, _) -> getModuleHash hirModIface == cf_iface_hash + _ -> True) HiFileResult{..} where hirIfaceFp = fingerprintToBS . getModuleHash $ hirModIface -- will always be two bytes diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs index 7f2cee0a8c..e49b9ad91d 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs @@ -2,6 +2,7 @@ -- has the constraints we need on it when we get it out. {-# OPTIONS_GHC -Wno-redundant-constraints #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} @@ -27,7 +28,6 @@ import Data.Dynamic import Data.Either import Data.Foldable (for_, traverse_) import Data.IORef.Extra -import Data.List.NonEmpty (unzip) import Data.Maybe import Data.Traversable (for) import Data.Tuple.Extra @@ -42,6 +42,12 @@ import qualified StmContainers.Map as SMap import System.IO.Unsafe import System.Time.Extra (duration, sleep) +#if MIN_VERSION_base(4,19,0) +import Data.Functor (unzip) +#else +import Data.List.NonEmpty (unzip) +#endif + newDatabase :: Dynamic -> TheRules -> IO Database newDatabase databaseExtra databaseRules = do diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 9ec752ac51..4a62f1cec4 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -5,73 +5,74 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE PatternSynonyms #-} module Ide.Plugin.Splice ( descriptor, ) where -import Control.Applicative (Alternative ((<|>))) -import Control.Arrow ( Arrow(first) ) -import Control.Exception ( SomeException ) -import qualified Control.Foldl as L -import Control.Lens (Identity (..), ix, view, (%~), - (<&>), (^.)) -import Control.Monad ( guard, unless, forM ) -import Control.Monad.Error.Class ( MonadError(throwError) ) -import Control.Monad.Extra (eitherM) -import qualified Control.Monad.Fail as Fail -import Control.Monad.IO.Unlift ( MonadIO(..), askRunInIO ) -import Control.Monad.Trans.Class ( MonadTrans(lift) ) -import Control.Monad.Trans.Except ( ExceptT(..), runExceptT ) +import Control.Applicative (Alternative ((<|>))) +import Control.Arrow (Arrow (first)) +import Control.Exception (SomeException) +import qualified Control.Foldl as L +import Control.Lens (Identity (..), ix, + view, (%~), (<&>), + (^.)) +import Control.Monad (forM, guard, unless) +import Control.Monad.Error.Class (MonadError (throwError)) +import Control.Monad.Extra (eitherM) +import qualified Control.Monad.Fail as Fail +import Control.Monad.IO.Unlift (MonadIO (..), + askRunInIO) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Except (ExceptT (..), + runExceptT) import Control.Monad.Trans.Maybe -import Data.Aeson hiding (Null) -import qualified Data.Bifunctor as B (first) -import Data.Foldable (Foldable (foldl')) +import Data.Aeson hiding (Null) +import qualified Data.Bifunctor as B (first) import Data.Function import Data.Generics -import qualified Data.Kind as Kinds -import Data.List (sortOn) -import Data.Maybe (fromMaybe, listToMaybe, - mapMaybe) -import qualified Data.Text as T +import qualified Data.Kind as Kinds +import Data.List (sortOn) +import Data.Maybe (fromMaybe, + listToMaybe, + mapMaybe) +import qualified Data.Text as T import Development.IDE import Development.IDE.Core.PluginUtils -import Development.IDE.GHC.Compat as Compat +import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.ExactPrint -import qualified Development.IDE.GHC.Compat.Util as Util +import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.ExactPrint -import Language.Haskell.GHC.ExactPrint.Transform (TransformT(TransformT)) - -#if MIN_VERSION_ghc(9,4,1) - -import GHC.Data.Bag (Bag) +import GHC.Exts +import qualified GHC.Types.Error as Error +import Ide.Plugin.Error (PluginError (PluginInternalError)) +import Ide.Plugin.Splice.Types +import Ide.Types +import Language.Haskell.GHC.ExactPrint (uniqueSrcSpanT) +import Language.Haskell.GHC.ExactPrint.Transform (TransformT (TransformT)) +import qualified Language.LSP.Protocol.Lens as J +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types +import Language.LSP.Server +#if !MIN_VERSION_base(4,20,0) +import Data.Foldable (Foldable (foldl')) #endif -import GHC.Exts - +#if MIN_VERSION_ghc(9,4,1) +import GHC.Data.Bag (Bag) +#endif #if MIN_VERSION_ghc(9,9,0) -import GHC.Parser.Annotation (EpAnn(..)) +import GHC.Parser.Annotation (EpAnn (..)) #else -import GHC.Parser.Annotation (SrcSpanAnn'(..)) +import GHC.Parser.Annotation (SrcSpanAnn' (..)) #endif -import qualified GHC.Types.Error as Error - - -import Ide.Plugin.Splice.Types -import Ide.Types -import Language.Haskell.GHC.ExactPrint (uniqueSrcSpanT) -import Language.LSP.Server -import Language.LSP.Protocol.Types -import Language.LSP.Protocol.Message -import qualified Language.LSP.Protocol.Lens as J -import Ide.Plugin.Error (PluginError(PluginInternalError)) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = @@ -227,10 +228,10 @@ setupDynFlagsForGHCiLike env dflags = do platform = targetPlatform dflags3 dflags3a = setWays hostFullWays dflags3 dflags3b = - foldl gopt_set dflags3a $ + foldl' gopt_set dflags3a $ concatMap (wayGeneralFlags platform) hostFullWays dflags3c = - foldl gopt_unset dflags3b $ + foldl' gopt_unset dflags3b $ concatMap (wayUnsetGeneralFlags platform) hostFullWays dflags4 = dflags3c @@ -249,7 +250,7 @@ adjustToRange uri ran (WorkspaceEdit mhult mlt x) = let minStart = case L.fold (L.premap (view J.range) L.minimum) eds of Nothing -> error "impossible" - Just v -> v + Just v -> v in adjustLine minStart <$> eds adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit) @@ -314,7 +315,7 @@ instance HasSplice AnnListItem HsExpr where #if MIN_VERSION_ghc(9,5,0) type SpliceOf HsExpr = HsSpliceCompat matchSplice _ (HsUntypedSplice _ spl) = Just (UntypedSplice spl) - matchSplice _ (HsTypedSplice _ spl) = Just (TypedSplice spl) + matchSplice _ (HsTypedSplice _ spl) = Just (TypedSplice spl) #else type SpliceOf HsExpr = HsSplice matchSplice _ (HsSpliceE _ spl) = Just spl @@ -403,7 +404,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e (fst <$> expandSplice astP spl) ) Just <$> case eExpr of - Left x -> pure $ L _spn x + Left x -> pure $ L _spn x Right y -> unRenamedE dflags y _ -> pure Nothing let (warns, errs) = @@ -515,12 +516,12 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = do | spanIsRelevant l -> case expr of #if MIN_VERSION_ghc(9,5,0) - HsTypedSplice{} -> Here (spLoc, Expr) + HsTypedSplice{} -> Here (spLoc, Expr) HsUntypedSplice{} -> Here (spLoc, Expr) #else - HsSpliceE {} -> Here (spLoc, Expr) + HsSpliceE {} -> Here (spLoc, Expr) #endif - _ -> Continue + _ -> Continue _ -> Stop ) `extQ` \case From adebee5690a9f103dc6b80d2a2c0ecabf4d40e44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 13:52:12 +0200 Subject: [PATCH 04/21] Fix flags job for hls-graph --- hls-graph/src/Development/IDE/Graph/Internal/Profile.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs index 408e3d2f12..0916ea00b2 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Char import Data.Dynamic (toDyn) import qualified Data.HashMap.Strict as Map -import Data.List (dropWhileEnd, foldl', +import Data.List (dropWhileEnd, intercalate, partition, sort, sortBy) @@ -33,6 +33,10 @@ import System.FilePath import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra (Seconds) +#if !MIN_VERSION_base(4,19,0) +import Data.List (foldl') +#endif + #ifdef FILE_EMBED import Data.FileEmbed import Language.Haskell.TH.Syntax (runIO) From 263bd98961e403ceddb30e7d0046ad114a7e09ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 14:10:07 +0200 Subject: [PATCH 05/21] foldl' exposed from Prelude since base 4.20 --- hls-graph/src/Development/IDE/Graph/Internal/Profile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs index 0916ea00b2..5369c578f8 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs @@ -33,7 +33,7 @@ import System.FilePath import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra (Seconds) -#if !MIN_VERSION_base(4,19,0) +#if !MIN_VERSION_base(4,20,0) import Data.List (foldl') #endif From cd5d313cfa23ced32218987d01f11cc6340d1279 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 15:04:22 +0200 Subject: [PATCH 06/21] Fix flags job for hls-plugin-api --- hls-plugin-api/src/Ide/Plugin/RangeMap.hs | 6 +++++- hls-plugin-api/src/Ide/Types.hs | 5 ++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/RangeMap.hs b/hls-plugin-api/src/Ide/Plugin/RangeMap.hs index 8ec62e68e6..7b1887a802 100644 --- a/hls-plugin-api/src/Ide/Plugin/RangeMap.hs +++ b/hls-plugin-api/src/Ide/Plugin/RangeMap.hs @@ -16,9 +16,9 @@ module Ide.Plugin.RangeMap ) where import Development.IDE.Graph.Classes (NFData) + #ifdef USE_FINGERTREE import Data.Bifunctor (first) -import Data.Foldable (foldl') import qualified HaskellWorks.Data.IntervalMap.FingerTree as IM import Language.LSP.Protocol.Types (Position, Range (Range)) @@ -26,6 +26,10 @@ import Language.LSP.Protocol.Types (Position, import Language.LSP.Protocol.Types (Range, isSubrangeOf) #endif +#if USE_FINGERTREE && !MIN_VERSION_base(4,20,0) +import Data.List (foldl') +#endif + -- | A map from code ranges to values. #ifdef USE_FINGERTREE newtype RangeMap a = RangeMap diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 5212b2c6da..faacaceacf 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -70,7 +70,6 @@ import Data.Default import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap import qualified Data.DList as DList -import Data.Foldable (foldl') import Data.GADT.Compare import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) @@ -103,6 +102,10 @@ import Prettyprinter as PP import System.FilePath import System.IO.Unsafe import Text.Regex.TDFA.Text () + +#if !MIN_VERSION_base(4,20,0) +import Data.Foldable (foldl') +#endif -- --------------------------------------------------------------------- data IdePlugins ideState = IdePlugins_ From d650b8a468ec8cf7e08ca0b5b5ac68d69e782ad5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 15:18:42 +0200 Subject: [PATCH 07/21] Fix ghcide hover test --- ghcide/test/exe/FindDefinitionAndHoverTests.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index b50f4081ff..31f6e04548 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -136,7 +137,13 @@ tests = let xvL20 = Position 24 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["pack", ":: String -> Text", "Data.Text", "text"]] clL23 = Position 27 11 ; cls = [mkR 25 0 26 20, ExpectHoverText ["MyClass", "GotoHover.hs:26:1"]] clL25 = Position 29 9 - eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", "GHC.Num", "base"]] + eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", ghcNum, "base"]] + ; ghcNum = +#if MIN_VERSION_base(4,20,0) + "GHC.Internal.Num" +#else + "GHC.Num" +#endif dnbL29 = Position 33 18 ; dnb = [ExpectHoverText [":: ()"], mkR 33 12 33 21] dnbL30 = Position 34 23 lcbL33 = Position 37 26 ; lcb = [ExpectHoverText [":: Char"], mkR 37 26 37 27] From 2a6da3c4d4d953e9920034119025a12e31ff3ef3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 15:42:29 +0200 Subject: [PATCH 08/21] Fix flags job for hls-eval-plugin --- .../src/Ide/Plugin/Eval/Parse/Comments.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs index 07667cc1bd..f098744dba 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -40,6 +41,13 @@ import Text.Megaparsec.Char (alphaNumChar, char, eol, hspace, letterChar) +#if MIN_VERSION_base(4,20,0) +import Data.Functor (unzip) +import Prelude hiding (unzip) +#else +import Data.List.NonEmpty (unzip) +#endif + {- We build parsers combining the following three kinds of them: @@ -407,7 +415,7 @@ nonEmptyLGP = exampleLinesGP :: LineGroupParser TestComment exampleLinesGP = lexemeLine $ - uncurry AnExample . first convexHullRange . NE.unzip + uncurry AnExample . first convexHullRange . unzip <$> NE.some exampleLineGP <*> resultLinesP From 998a62afe7344810e50dd3e514fb4bbba13257a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 15:51:24 +0200 Subject: [PATCH 09/21] unzip since 4.19 --- plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs index f098744dba..6a29e31b10 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -41,7 +41,7 @@ import Text.Megaparsec.Char (alphaNumChar, char, eol, hspace, letterChar) -#if MIN_VERSION_base(4,20,0) +#if MIN_VERSION_base(4,19,0) import Data.Functor (unzip) import Prelude hiding (unzip) #else From 3c738e3233592bec99ae391c69105f0b4d2a153e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 17:25:40 +0200 Subject: [PATCH 10/21] More pedantic fixes --- .../hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs | 4 ++-- .../src/Ide/Plugin/Eval/Parse/Comments.hs | 9 ++++----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index d4718766ba..c08e4344a6 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -57,7 +57,7 @@ addMethodDecls ps mDecls range withSig -- See the link for the original definition: -- https://hackage.haskell.org/package/ghc-9.2.1/docs/Language-Haskell-Syntax-Extension.html#t:XCClsInstDecl addWhere :: HsDecl GhcPs -> HsDecl GhcPs - addWhere instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) = + addWhere _instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) = case cid_ext of #if MIN_VERSION_ghc(9,9,0) (warnings, anns, key) -> @@ -75,7 +75,7 @@ addMethodDecls ps mDecls range withSig comments , key) }) - _ -> instd + _ -> _instd #endif addWhere decl = decl diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs index 6a29e31b10..6f8b303302 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -25,7 +25,7 @@ import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Functor.Identity import Data.List.NonEmpty (NonEmpty ((:|))) -import qualified Data.List.NonEmpty as NE +import qualified Data.List.NonEmpty as NE hiding (unzip) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Data.Text as T @@ -42,10 +42,9 @@ import Text.Megaparsec.Char (alphaNumChar, char, letterChar) #if MIN_VERSION_base(4,19,0) -import Data.Functor (unzip) -import Prelude hiding (unzip) +import qualified Data.Functor as NE (unzip) #else -import Data.List.NonEmpty (unzip) +import qualified Data.List.NonEmpty as NE (unzip) #endif {- @@ -415,7 +414,7 @@ nonEmptyLGP = exampleLinesGP :: LineGroupParser TestComment exampleLinesGP = lexemeLine $ - uncurry AnExample . first convexHullRange . unzip + uncurry AnExample . first convexHullRange . NE.unzip <$> NE.some exampleLineGP <*> resultLinesP From 125286eaf957925488200271a6f3dafe9c343512 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 16 May 2024 18:35:20 +0200 Subject: [PATCH 11/21] Don't CPP in tests, fix another test --- ghcide/src/Development/IDE/GHC/Compat.hs | 5 ++++- ghcide/test/exe/CodeLensTests.hs | 6 +++++- ghcide/test/exe/FindDefinitionAndHoverTests.hs | 9 +-------- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 59b28cf637..b377fec0c7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -514,13 +514,16 @@ data GhcVersion | GHC94 | GHC96 | GHC98 + | GHC910 deriving (Eq, Ord, Show) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,10,0,0) +ghcVersion = GHC910 +#elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) ghcVersion = GHC98 #elif MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) ghcVersion = GHC96 diff --git a/ghcide/test/exe/CodeLensTests.hs b/ghcide/test/exe/CodeLensTests.hs index 6bebeda002..5fa86de3ae 100644 --- a/ghcide/test/exe/CodeLensTests.hs +++ b/ghcide/test/exe/CodeLensTests.hs @@ -88,7 +88,11 @@ addSigLensesTests = , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"") , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") , ("typeOperatorTest = Refl", "typeOperatorTest :: forall {k} {a :: k}. a :~: a") - , ("notInScopeTest = mkCharType", "notInScopeTest :: String -> Data.Data.DataType") + , ("notInScopeTest = mkCharType" + , if ghcVersion < GHC910 + then "notInScopeTest :: String -> Data.Data.DataType" + else "notInScopeTest :: String -> GHC.Internal.Data.Data.DataType" + ) , ("aVeryLongSignature a b c d e f g h i j k l m n = a && b && c && d && e && f && g && h && i && j && k && l && m && n", "aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool") ] in testGroup diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index 31f6e04548..c5f46436e5 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -137,13 +136,7 @@ tests = let xvL20 = Position 24 8 ; xvMsg = [ExpectExternFail, ExpectHoverText ["pack", ":: String -> Text", "Data.Text", "text"]] clL23 = Position 27 11 ; cls = [mkR 25 0 26 20, ExpectHoverText ["MyClass", "GotoHover.hs:26:1"]] clL25 = Position 29 9 - eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", ghcNum, "base"]] - ; ghcNum = -#if MIN_VERSION_base(4,20,0) - "GHC.Internal.Num" -#else - "GHC.Num" -#endif + eclL15 = Position 19 8 ; ecls = [ExpectExternFail, ExpectHoverText ["Num", "Defined in ", if ghcVersion < GHC910 then "GHC.Num" else "GHC.Internal.Num", "base"]] dnbL29 = Position 33 18 ; dnb = [ExpectHoverText [":: ()"], mkR 33 12 33 21] dnbL30 = Position 34 23 lcbL33 = Position 37 26 ; lcb = [ExpectHoverText [":: Char"], mkR 37 26 37 27] From 55975cefbe8fac0574cec0989dac93f3771ba13e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 17 May 2024 06:04:28 +0200 Subject: [PATCH 12/21] Switch to ghc-exactprint and witherable from hackage --- cabal.project | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index 52d17c1d4e..25d1f43ad7 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-16T08:02:44Z +index-state: 2024-05-17T03:42:00Z tests: True test-show-details: direct @@ -45,10 +45,6 @@ constraints: if impl(ghc >= 9.9) benchmarks: False - source-repository-package - type:git - location: https://github.com/alanz/ghc-exactprint.git - tag: 68ba2b8135c275737523217a546d7b58b5c5d050 source-repository-package type:git location: https://github.com/wz1000/retrie.git @@ -96,6 +92,5 @@ if impl(ghc >= 9.9) tasty-hspec:base, these:base, uuid-types:template-haskell, - witherable:containers, else benchmarks: True From c4bd43cbdb916eac36297a6ee0af7987bb0f4515 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 17 May 2024 07:06:37 +0200 Subject: [PATCH 13/21] Fix all warnings in hls-refactor-plugin --- haskell-language-server.cabal | 3 +- .../src/Development/IDE/GHC/Dump.hs | 3 +- .../src/Development/IDE/GHC/ExactPrint.hs | 54 ++++++++++--------- .../src/Development/IDE/Plugin/CodeAction.hs | 28 ++++++---- .../IDE/Plugin/CodeAction/ExactPrint.hs | 33 ++++++------ .../IDE/Plugin/Plugins/AddArgument.hs | 20 ++++--- 6 files changed, 77 insertions(+), 64 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 5f673caafe..75abe478ad 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1662,11 +1662,12 @@ library hls-refactor-plugin , deepseq , mtl , lens - , data-default , time -- FIXME: Only needed to workaround for qualified imports in GHC 9.4 , regex-applicative , parser-combinators + if impl(ghc < 9.10) + build-depends: data-default test-suite hls-refactor-plugin-tests import: defaults, pedantic, test-defaults, warnings diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index f015ea7658..8aee3d5bad 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -271,8 +271,7 @@ showAstDataHtml a0 = html $ srcSpanAnnN :: EpAnn NameAnn -> SDoc srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN") - locatedAnn'' :: forall a. (Typeable a, Data a) - => SDoc -> EpAnn a -> SDoc + locatedAnn'' :: forall a. Data a => SDoc -> EpAnn a -> SDoc locatedAnn'' tag ss = parens $ case cast ss of Just (ann :: EpAnn a) -> diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 2420665215..c20c216f16 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -54,7 +54,6 @@ import Control.Monad.Trans.Except import Control.Monad.Zip import Data.Bifunctor import Data.Bool (bool) -import Data.Default (Default) import qualified Data.DList as DL import Data.Either.Extra (mapLeft) import Data.Functor.Classes @@ -84,46 +83,49 @@ import Retrie.ExactPrint hiding (parseDecl, parseExpr, parsePattern, parseType) -#if MIN_VERSION_ghc(9,9,0) -import GHC.Plugins (showSDoc) -import GHC.Utils.Outputable (Outputable (ppr)) -#else -import GHC (EpAnn (..), + + +import Control.Lens (_last, (&)) +import Control.Lens.Operators ((%~)) +import Data.List (partition) +import GHC (DeltaPos (..), + SrcSpanAnnN) + +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + +#if !MIN_VERSION_ghc(9,9,0) +import Data.Default (Default) +import GHC (Anchor (..), + AnchorOperation, + EpAnn (..), NameAdornment (NameParens), NameAnn (..), SrcSpanAnn' (SrcSpanAnn), SrcSpanAnnA, TrailingAnn (AddCommaAnn), emptyComments, + realSrcSpan, spanAsAnchor) import GHC.Parser.Annotation (AnnContext (..), EpaLocation (EpaDelta), deltaPos) +import GHC.Types.SrcLoc (generatedSrcSpan) #endif -import Control.Lens (_last, (&)) -import Control.Lens.Operators ((%~)) -import Data.List (partition) -import GHC (Anchor (..), #if MIN_VERSION_ghc(9,9,0) - EpAnn(..), - EpaLocation(..), - AnnContext(..), +import GHC (Anchor, + AnnContext (..), + EpAnn (..), + EpaLocation, + EpaLocation' (..), + NameAdornment (..), + NameAnn (..), SrcSpanAnnA, - NameAnn(..), - TrailingAnn(..), + TrailingAnn (..), deltaPos, - EpaLocation'(..), - spanAsAnchor, emptyComments, - NameAdornment(..), -#else - AnchorOperation, + spanAsAnchor) #endif - DeltaPos (..), - SrcSpanAnnN, - realSrcSpan) -import GHC.Types.SrcLoc (generatedSrcSpan) setPrecedingLines :: #if !MIN_VERSION_ghc(9,9,0) @@ -474,8 +476,8 @@ setAnchor anc (EpAnn _ nameAnn comments) = #else setAnchor anc (SrcSpanAnn (EpAnn _ nameAnn comments) span) = SrcSpanAnn (EpAnn anc nameAnn comments) span -#endif setAnchor _ spanAnnN = spanAnnN +#endif removeTrailingAnns :: SrcSpanAnnN -> SrcSpanAnnN #if MIN_VERSION_ghc(9,9,0) @@ -486,8 +488,8 @@ removeTrailingAnns (EpAnn anc nameAnn comments) = removeTrailingAnns (SrcSpanAnn (EpAnn anc nameAnn comments) span) = let nameAnnSansTrailings = nameAnn {nann_trailing = []} in SrcSpanAnn (EpAnn anc nameAnnSansTrailings comments) span -#endif removeTrailingAnns spanAnnN = spanAnnN +#endif -- | Modify the type signature for the given IdP. This function handles splitting a multi-sig -- SigD into multiple SigD if the type signature is changed. diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 2a6c96f002..39b362e20b 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1,5 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} module Development.IDE.Plugin.CodeAction @@ -67,21 +68,10 @@ import Development.IDE.Plugin.TypeLenses (suggestSigna import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options -#if MIN_VERSION_ghc(9,9,0) -import GHC.Types.SrcLoc (srcSpanToRealSrcSpan) -#endif import GHC (AddEpAnn (AddEpAnn), -#if MIN_VERSION_ghc(9,9,0) - HasLoc(..), - EpaLocation'(..), -#else - Anchor (anchor_op), - AnchorOperation (..), -#endif AnnsModule (am_main), DeltaPos (..), EpAnn (..), - EpaLocation (..), LEpaComment) import qualified GHC.LanguageExtensions as Lang import Ide.Logger hiding @@ -113,6 +103,22 @@ import qualified Text.Fuzzy.Parallel as TFP import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + +#if !MIN_VERSION_ghc(9,9,0) +import GHC (Anchor (anchor_op), + AnchorOperation (..), + EpaLocation (..)) +#endif + +#if MIN_VERSION_ghc(9,9,0) +import GHC (EpaLocation, + EpaLocation' (..), + HasLoc (..)) +import GHC.Types.SrcLoc (srcSpanToRealSrcSpan) +#endif + + ------------------------------------------------------------------------------------------------- -- | Generate code actions. diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index b1f946ba61..f3e1af0d23 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -31,33 +31,33 @@ import GHC.Stack (HasCallStack) import Language.Haskell.GHC.ExactPrint import Language.LSP.Protocol.Types -import Development.IDE.Plugin.CodeAction.Util - --- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports. import Control.Lens (_head, _last, over) import Data.Bifunctor (first) -import Data.Default (Default (..)) -import Data.Maybe (fromMaybe, - mapMaybe) +import Data.Maybe (fromMaybe, mapMaybe) +import Development.IDE.Plugin.CodeAction.Util import GHC (AddEpAnn (..), AnnContext (..), AnnList (..), AnnParen (..), DeltaPos (SameLine), EpAnn (..), -#if !MIN_VERSION_ghc(9,9,0) - EpaLocation(EpaDelta), - ann, -#else - EpaLocation'(..), - NoAnn(..), -#endif IsUnicodeSyntax (NormalSyntax), NameAdornment (NameParens), TrailingAnn (AddCommaAnn), - addAnns, emptyComments, reAnnL) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + +#if !MIN_VERSION_ghc(9,9,0) +import Data.Default (Default (..)) +import GHC (EpaLocation (EpaDelta), + addAnns, ann) +#endif + +#if MIN_VERSION_ghc(9,9,0) +import GHC (EpaLocation' (..), + NoAnn (..)) +#endif ------------------------------------------------------------------------------ @@ -482,11 +482,12 @@ addCommaInImportList lies x = L lastItemSrcAnn _ <- lastMaybe lies #if MIN_VERSION_ghc(9,9,0) lastItemAnn <- case lastItemSrcAnn of + EpAnn _ lastItemAnn _ -> pure lastItemAnn #else lastItemAnn <- case ann lastItemSrcAnn of -#endif EpAnn _ lastItemAnn _ -> pure lastItemAnn _ -> Nothing +#endif pure $ any isTrailingAnnComma (lann_trailing lastItemAnn) hasSibling = not $ null lies @@ -539,10 +540,10 @@ extendHiding :: extendHiding symbol (L l idecls) mlies df = do L l' lies <- case mlies of Nothing -> do - src <- uniqueSrcSpanT #if MIN_VERSION_ghc(9,9,0) let ann = noAnnSrcSpanDP0 #else + src <- uniqueSrcSpanT let ann = noAnnSrcSpanDP0 src #endif #if MIN_VERSION_ghc(9,9,0) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs index 440b17f57d..184ab93e79 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -16,16 +16,10 @@ import Development.IDE.GHC.ExactPrint (genAnchor1, modifySmallestDeclWithM) import Development.IDE.Plugin.Plugins.Diagnostic import GHC (EpAnn (..), -#if MIN_VERSION_ghc(9,9,0) - EpUniToken(..), -#else - SrcSpanAnn' (SrcSpanAnn), -#endif SrcSpanAnnA, SrcSpanAnnN, emptyComments, noAnn) -import GHC.Types.SrcLoc (generatedSrcSpan) import Ide.Plugin.Error (PluginError (PluginInternalError)) import Ide.PluginUtils (makeDiffTextEdit) import Language.Haskell.GHC.ExactPrint (TransformT (..), @@ -33,17 +27,28 @@ import Language.Haskell.GHC.ExactPrint (TransformT (..), runTransformT) import Language.LSP.Protocol.Types +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,4,0) import GHC (TrailingAnn (..)) import GHC.Hs (IsUnicodeSyntax (..)) import Language.Haskell.GHC.ExactPrint.Transform (d1) #endif -#if MIN_VERSION_ghc(9,4,0) +#if MIN_VERSION_ghc(9,4,0) && !MIN_VERSION_ghc(9,9,0) import Development.IDE.GHC.ExactPrint (epl) import GHC.Parser.Annotation (TokenLocation (..)) #endif +#if !MIN_VERSION_ghc(9,9,0) +import GHC (SrcSpanAnn' (SrcSpanAnn)) +import GHC.Types.SrcLoc (generatedSrcSpan) +#endif + +#if MIN_VERSION_ghc(9,9,0) +import GHC (EpUniToken (..)) +#endif + -- When GHC tells us that a variable is not bound, it will tell us either: -- - there is an unbound variable with a given type -- - there is an unbound variable (GHC provides no type suggestion) @@ -167,4 +172,3 @@ addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) = insertArg n (a:as) = a : insertArg (n - 1) as lsigTy' = hsTypeFromFunTypeAsList (insertArg loc args, res) in L annHsSig (HsSig xHsSig tyVarBndrs lsigTy') - From 8bfb302d99700ac44a4500564f9cdeb0d44d24ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 17 May 2024 07:25:13 +0200 Subject: [PATCH 14/21] Remove more no longer necessary allow newers --- cabal.project | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/cabal.project b/cabal.project index 25d1f43ad7..9ab0f6d1ee 100644 --- a/cabal.project +++ b/cabal.project @@ -53,8 +53,6 @@ if impl(ghc >= 9.9) lens >= 5.3.2, haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, allow-newer: - aeson:containers, - aeson:template-haskell, boring:base, co-log-core:base, constraints-extras:base, @@ -66,7 +64,6 @@ if impl(ghc >= 9.9) entropy:filepath, entropy:process, free:template-haskell, - generically:base, ghc-trace-events:base, haddock-library:base, haddock-library:containers, @@ -84,13 +81,6 @@ if impl(ghc >= 9.9) monoid-subclasses:containers, quickcheck-instances:base, quickcheck-instances:containers, - semialign:base, - semialign:containers, - some:base, - text-short:base, - text-short:template-haskell, - tasty-hspec:base, - these:base, uuid-types:template-haskell, else benchmarks: True From 0f86666476a690d429dc57b46df9b80ef4afd8d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 17 May 2024 07:36:55 +0200 Subject: [PATCH 15/21] Fix all warnings in hls-gadp-plugin and hls-qualify-imported-names-plugin --- plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs | 38 +++++++++++-------- .../src/Ide/Plugin/QualifyImportedNames.hs | 7 +++- 2 files changed, 28 insertions(+), 17 deletions(-) diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index 453bbd8334..fff2096d44 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -14,33 +14,39 @@ import Development.IDE import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.ExactPrint import GHC.Parser.Annotation (AddEpAnn (..), -#if MIN_VERSION_ghc(9,9,0) - EpaLocation'(..), - EpUniToken(..), - noAnn, -#else - Anchor (Anchor), - AnchorOperation (MovedAnchor), - EpaLocation (EpaDelta), - SrcSpanAnn' (SrcSpanAnn), -#endif DeltaPos (..), EpAnn (..), EpAnnComments (EpaComments), spanAsAnchor) import Ide.PluginUtils (subRange) -#if MIN_VERSION_ghc(9,9,0) -import Language.Haskell.GHC.ExactPrint.Utils (showAst) -#else -import Language.Haskell.GHC.ExactPrint (showAst) -#endif import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if MIN_VERSION_ghc(9,5,0) import qualified Data.List.NonEmpty as NE +#endif + +#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,9,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif +#if !MIN_VERSION_ghc(9,9,0) +import GHC.Parser.Annotation (Anchor (Anchor), + AnchorOperation (MovedAnchor), + EpaLocation (EpaDelta), + SrcSpanAnn' (SrcSpanAnn)) +import Language.Haskell.GHC.ExactPrint (showAst) +#endif + +#if MIN_VERSION_ghc(9,9,0) +import GHC.Parser.Annotation (EpUniToken (..), + EpaLocation' (..), + noAnn) +import Language.Haskell.GHC.ExactPrint.Utils (showAst) +#endif + + type GP = GhcPass Parsed -- | Check if a given range is in the range of located item @@ -229,7 +235,7 @@ prettyGADTDecl df decl = #endif where #if MIN_VERSION_ghc(9,9,0) - go _ = EpaDelta (DifferentLine 1 2) [] + go _ = EpaDelta (DifferentLine 1 2) [] #else go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2)) #endif 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 7027feeb99..8b73c9114e 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,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -12,7 +13,7 @@ import Control.Monad.Trans.State.Strict (State) import qualified Control.Monad.Trans.State.Strict as State import Data.DList (DList) import qualified Data.DList as DList -import Data.Foldable (Foldable (foldl'), find) +import Data.Foldable (find) import Data.List (sortOn) import qualified Data.List as List import qualified Data.Map.Strict as Map @@ -72,6 +73,10 @@ import Language.LSP.Protocol.Types (CodeAction (CodeAction, _comm WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (InL, InR)) +#if !MIN_VERSION_base(4,20,0) +import Data.Foldable (foldl') +#endif + thenCmp :: Ordering -> Ordering -> Ordering {-# INLINE thenCmp #-} thenCmp EQ ordering = ordering From 83da67267635835eb802b2b48497e6e3dd913b0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 17 May 2024 12:55:55 +0200 Subject: [PATCH 16/21] Remove allow-newer for boring --- cabal.project | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 9ab0f6d1ee..1b19584500 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-17T03:42:00Z +index-state: 2024-05-17T10:42:08Z tests: True test-show-details: direct @@ -53,7 +53,6 @@ if impl(ghc >= 9.9) lens >= 5.3.2, haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, allow-newer: - boring:base, co-log-core:base, constraints-extras:base, constraints-extras:template-haskell, From 9cd79b38c63b74aa62939cd9abce8fb3e94b39c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 17 May 2024 14:06:11 +0200 Subject: [PATCH 17/21] Bump to lsp 2.6, remove more allow-newers --- cabal.project | 10 +--------- ghcide/ghcide.cabal | 2 +- haskell-language-server.cabal | 14 +++++++------- hls-plugin-api/hls-plugin-api.cabal | 2 +- 4 files changed, 10 insertions(+), 18 deletions(-) diff --git a/cabal.project b/cabal.project index 1b19584500..e3faa0da80 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-17T10:42:08Z +index-state: 2024-05-17T11:58:03Z tests: True test-show-details: direct @@ -69,14 +69,6 @@ if impl(ghc >= 9.9) hie-bios:ghc, hiedb:base, hiedb:ghc, - lens:template-haskell, - lsp:containers, - lsp:lens, - lsp-test:containers, - lsp-test:lens, - lsp-types:containers, - lsp-types:lens, - lsp-types:template-haskell, monoid-subclasses:containers, quickcheck-instances:base, quickcheck-instances:containers, diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 0d70f31bb7..2b5be914d4 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -88,7 +88,7 @@ library , implicit-hie >= 0.1.4.0 && < 0.1.5 , lens , list-t - , lsp ^>=2.5.0.0 + , lsp ^>=2.6.0.0 , lsp-types ^>=2.2.0.0 , mtl , opentelemetry >=0.6.1 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 75abe478ad..3beb1ccff0 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -258,7 +258,7 @@ library hls-cabal-plugin , hls-plugin-api == 2.8.0.0 , hls-graph == 2.8.0.0 , lens - , lsp ^>=2.5 + , lsp ^>=2.6 , lsp-types ^>=2.2 , regex-tdfa ^>=1.3.1 , text @@ -389,7 +389,7 @@ library hls-call-hierarchy-plugin , hiedb ^>= 0.6.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.5 + , lsp >=2.6 , sqlite-simple , text @@ -1002,7 +1002,7 @@ library hls-alternate-number-format-plugin , hls-graph , hls-plugin-api == 2.8.0.0 , lens - , lsp ^>=2.5 + , lsp ^>=2.6 , mtl , regex-tdfa , syb @@ -1232,7 +1232,7 @@ library hls-gadt-plugin , hls-plugin-api == 2.8.0.0 , haskell-language-server:hls-refactor-plugin , lens - , lsp >=2.5 + , lsp >=2.6 , mtl , text , transformers @@ -1281,7 +1281,7 @@ library hls-explicit-fixity-plugin , ghcide == 2.8.0.0 , hashable , hls-plugin-api == 2.8.0.0 - , lsp >=2.5 + , lsp >=2.6 , text default-extensions: DataKinds @@ -1737,7 +1737,7 @@ library hls-semantic-tokens-plugin , ghcide == 2.8.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.5 + , lsp >=2.6 , text , transformers , bytestring @@ -1805,7 +1805,7 @@ library hls-notes-plugin , hls-graph == 2.8.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.5 + , lsp >=2.6 , mtl >= 2.2 , regex-tdfa >= 1.3.1 , text diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 4e8bb6742c..eef8a7038c 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -69,7 +69,7 @@ library , hls-graph == 2.8.0.0 , lens , lens-aeson - , lsp ^>=2.5 + , lsp ^>=2.6 , megaparsec >=9.0 , mtl , opentelemetry >=0.4 From ed044ce14425065e0a8aa37bd33d3fc9ee9a6ff2 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Fri, 17 May 2024 17:40:20 +0530 Subject: [PATCH 18/21] outline tests --- ghcide/test/exe/FindDefinitionAndHoverTests.hs | 2 +- ghcide/test/exe/OutlineTests.hs | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index c5f46436e5..ccf992678f 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -159,7 +159,7 @@ tests = let holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]] cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"] imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3] - reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 (if ghcVersion >= GHC94 then 5 else 0) 3 (if ghcVersion >= GHC94 then 8 else 14)] + reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 (if ghcVersion >= GHC94 && ghcVersion < GHC910 then 5 else 0) 3 (if ghcVersion >= GHC94 && ghcVersion < GHC910 then 8 else 14)] thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]] cmtL68 = Position 67 0 ; lackOfdEq = [ExpectHoverExcludeText ["$dEq"]] import310 = Position 3 10; pkgTxt = [ExpectHoverText ["Data.Text\n\ntext-"]] diff --git a/ghcide/test/exe/OutlineTests.hs b/ghcide/test/exe/OutlineTests.hs index 640e13a907..82d2131050 100644 --- a/ghcide/test/exe/OutlineTests.hs +++ b/ghcide/test/exe/OutlineTests.hs @@ -7,6 +7,7 @@ import Config import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import qualified Data.Text as T +import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..), SemanticTokenRelative (..), SemanticTokensEdit (..), mkRange) @@ -55,11 +56,11 @@ tests = [ docSymbolD "A a" "type family" SymbolKind_Function (R 1 0 1 15), docSymbol "A ()" SymbolKind_Interface (R 2 0 2 23) ], - testSymbolsA "data family" ["{-# language TypeFamilies #-}", "data family A"] [docSymbolD "A" "data family" SymbolKind_Function (R 1 0 1 11)], + testSymbolsA "data family" ["{-# language TypeFamilies #-}", "data family A"] [docSymbolD "A" "data family" SymbolKind_Function (R 1 0 1 (if ghcVersion >= GHC910 then 13 else 11))], testSymbolsA "data family instance " ["{-# language TypeFamilies #-}", "data family A a", "data instance A () = A ()"] - [ docSymbolD "A a" "data family" SymbolKind_Function (R 1 0 1 11), + [ docSymbolD "A a" "data family" SymbolKind_Function (R 1 0 1 (if ghcVersion >= GHC910 then 15 else 11)), docSymbol "A ()" SymbolKind_Interface (R 2 0 2 25) ], testSymbolsA "constant" ["a = ()"] [docSymbol "a" SymbolKind_Function (R 0 0 0 6)], From c7fa870033425eb1b22ca420c2ef70d540877693 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Fri, 17 May 2024 17:46:13 +0530 Subject: [PATCH 19/21] disable simple plugin on 9.10 --- ghcide/test/exe/PluginSimpleTests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/PluginSimpleTests.hs b/ghcide/test/exe/PluginSimpleTests.hs index cc5b5eba6c..169e8b2e39 100644 --- a/ghcide/test/exe/PluginSimpleTests.hs +++ b/ghcide/test/exe/PluginSimpleTests.hs @@ -36,7 +36,7 @@ tests = -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is -- required by plugin-1.0.0). See the build log above for details. - ignoreFor (BrokenForGHC [GHC96, GHC98]) "fragile, frequently times out" $ + ignoreFor (BrokenForGHC [GHC96, GHC98, GHC910]) "fragile, frequently times out" $ ignoreFor (BrokenSpecific Windows [GHC94]) "ghc-typelist-natnormalise fails to build on GHC 9.4.2 for windows only" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" From f29a55c410052dcef1b4a4484391745e85c634c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 18 May 2024 06:00:09 +0200 Subject: [PATCH 20/21] Remove allow-newer for ghc-trace-events --- cabal.project | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index e3faa0da80..ae5930a9aa 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-17T11:58:03Z +index-state: 2024-05-18T02:15:01Z tests: True test-show-details: direct @@ -63,7 +63,6 @@ if impl(ghc >= 9.9) entropy:filepath, entropy:process, free:template-haskell, - ghc-trace-events:base, haddock-library:base, haddock-library:containers, hie-bios:ghc, From 2746b1f1cd53b72aa331084e4a623ebdff086631 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sat, 18 May 2024 22:01:49 +0800 Subject: [PATCH 21/21] fix appendConstraint --- .../src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index f3e1af0d23..70a76ea73a 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -207,7 +207,7 @@ appendConstraint constraintT = go . traceAst "appendConstraint" #endif annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens] needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint - ast <- pure $ setEntryDP ast (SameLine 1) + ast <- pure $ setEntryDP (makeDeltaAst ast) (SameLine 1) return $ reLocA $ L lTop $ HsQualTy noExtField context ast