From 9dd43159169eec0f222c82f25c11a36db4bfcf93 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Tue, 7 May 2024 13:51:48 +0530 Subject: [PATCH 01/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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/83] 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 From 24e783110447aa5d146942c0408d6dcb8b136572 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sat, 18 May 2024 22:56:03 +0800 Subject: [PATCH 22/83] stylish --- ghcide/test/exe/OutlineTests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/OutlineTests.hs b/ghcide/test/exe/OutlineTests.hs index 82d2131050..0d336a6bd0 100644 --- a/ghcide/test/exe/OutlineTests.hs +++ b/ghcide/test/exe/OutlineTests.hs @@ -7,7 +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 Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..), SemanticTokenRelative (..), SemanticTokensEdit (..), mkRange) From 190894d979b0e18addca5367b4ca841b639a65ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 19 May 2024 06:17:29 +0200 Subject: [PATCH 23/83] Remove commutative-semigroups and monoid-subclasses from allow-newer --- cabal.project | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index ae5930a9aa..36e9c6f690 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-18T02:15:01Z +index-state: 2024-05-19T03:57:21Z tests: True test-show-details: direct @@ -56,7 +56,6 @@ if impl(ghc >= 9.9) co-log-core:base, constraints-extras:base, constraints-extras:template-haskell, - commutative-semigroups:base, dependent-map:containers, entropy:base, entropy:directory, @@ -68,7 +67,6 @@ if impl(ghc >= 9.9) hie-bios:ghc, hiedb:base, hiedb:ghc, - monoid-subclasses:containers, quickcheck-instances:base, quickcheck-instances:containers, uuid-types:template-haskell, From 0e61fa37598fa68b9dd2f2a0c0187c9c313eadfe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 19 May 2024 06:22:24 +0200 Subject: [PATCH 24/83] Remove free from allow-newer --- cabal.project | 1 - 1 file changed, 1 deletion(-) diff --git a/cabal.project b/cabal.project index 36e9c6f690..f6d3e54aa0 100644 --- a/cabal.project +++ b/cabal.project @@ -61,7 +61,6 @@ if impl(ghc >= 9.9) entropy:directory, entropy:filepath, entropy:process, - free:template-haskell, haddock-library:base, haddock-library:containers, hie-bios:ghc, From f72f2d9e249698593da0225a4ed603f5c9fb8b81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 19 May 2024 09:20:39 +0200 Subject: [PATCH 25/83] Fix 'type wilcard actions' tests --- plugins/hls-refactor-plugin/test/Main.hs | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 3670a3b398..d48da60e0c 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -642,7 +642,7 @@ typeWildCardActionTests = testGroup "type wildcard actions" [ "func :: _" , "func x = x" ] - [ "func :: p -> p" + [ if ghcVersion >= GHC910 then "func :: t -> t" else "func :: p -> p" , "func x = x" ] , testUseTypeSignature "local signature" @@ -662,9 +662,12 @@ typeWildCardActionTests = testGroup "type wildcard actions" [ "func :: _" , "func x y = x + y" ] - [ if ghcVersion >= GHC98 - then "func :: a -> a -> a" -- since 9.8 GHC no longer does type defaulting (see https://gitlab.haskell.org/ghc/ghc/-/issues/24522) - else "func :: Integer -> Integer -> Integer" + [ if ghcVersion >= GHC910 then + "func :: t -> t -> t" + else if ghcVersion >= GHC98 then + "func :: a -> a -> a" -- since 9.8 GHC no longer does type defaulting (see https://gitlab.haskell.org/ghc/ghc/-/issues/24522) + else + "func :: Integer -> Integer -> Integer" , "func x y = x + y" ] , testUseTypeSignature "type in parentheses" @@ -692,9 +695,12 @@ typeWildCardActionTests = testGroup "type wildcard actions" [ "func::_" , "func x y = x + y" ] - [ if ghcVersion >= GHC98 - then "func::a -> a -> a" -- since 9.8 GHC no longer does type defaulting (see https://gitlab.haskell.org/ghc/ghc/-/issues/24522) - else "func::Integer -> Integer -> Integer" + [ if ghcVersion >= GHC910 then + "func::t -> t -> t" + else if ghcVersion >= GHC98 then + "func::a -> a -> a" -- since 9.8 GHC no longer does type defaulting (see https://gitlab.haskell.org/ghc/ghc/-/issues/24522) + else + "func::Integer -> Integer -> Integer" , "func x y = x + y" ] , testGroup "add parens if hole is part of bigger type" From b0e117bc6ec328c2586cd1e4050d5c0a3d1fe85d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 19 May 2024 13:57:21 +0200 Subject: [PATCH 26/83] Remove hie-bios from allow-newer --- cabal.project | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index f6d3e54aa0..50d33d2ab4 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-19T03:57:21Z +index-state: 2024-05-19T11:52:03Z tests: True test-show-details: direct @@ -63,7 +63,6 @@ if impl(ghc >= 9.9) entropy:process, haddock-library:base, haddock-library:containers, - hie-bios:ghc, hiedb:base, hiedb:ghc, quickcheck-instances:base, From 2f3300e96489f043084f347d26349c63d2c1ec82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 19 May 2024 15:36:42 +0200 Subject: [PATCH 27/83] Fix suggestNewDefinition tests --- .../src/Development/IDE/Plugin/Plugins/AddArgument.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) 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 184ab93e79..1e2ff670e1 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 @@ -7,8 +7,7 @@ import Data.Bifunctor (Bifunctor (..)) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.ExactPrint (exactPrint, - makeDeltaAst) +import Development.IDE.GHC.Compat.ExactPrint (exactPrint) import Development.IDE.GHC.Error (spanContainsRange) import Development.IDE.GHC.ExactPrint (genAnchor1, modifyMgMatchesT', @@ -120,7 +119,7 @@ appendFinalPatToMatches name = \case addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either PluginError [(T.Text, [TextEdit])] addArgumentAction (ParsedModule _ moduleSrc _ _) range name _typ = do (newSource, _, _) <- runTransformT $ do - (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl (makeDeltaAst moduleSrc) + (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl moduleSrc case matchedDeclNameMay of Just (matchedDeclName, numPats) -> modifySigWithM (unLoc matchedDeclName) (addTyHoleToTySigArg numPats) moduleSrc' Nothing -> pure moduleSrc' From 86f28b7398225de1c1f5bd1c06d7df23c783dff3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 19 May 2024 16:03:51 +0200 Subject: [PATCH 28/83] Revert "Fix suggestNewDefinition tests" This reverts commit 2f3300e96489f043084f347d26349c63d2c1ec82. --- .../src/Development/IDE/Plugin/Plugins/AddArgument.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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 1e2ff670e1..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 @@ -7,7 +7,8 @@ import Data.Bifunctor (Bifunctor (..)) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.ExactPrint (exactPrint) +import Development.IDE.GHC.Compat.ExactPrint (exactPrint, + makeDeltaAst) import Development.IDE.GHC.Error (spanContainsRange) import Development.IDE.GHC.ExactPrint (genAnchor1, modifyMgMatchesT', @@ -119,7 +120,7 @@ appendFinalPatToMatches name = \case addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either PluginError [(T.Text, [TextEdit])] addArgumentAction (ParsedModule _ moduleSrc _ _) range name _typ = do (newSource, _, _) <- runTransformT $ do - (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl moduleSrc + (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl (makeDeltaAst moduleSrc) case matchedDeclNameMay of Just (matchedDeclName, numPats) -> modifySigWithM (unLoc matchedDeclName) (addTyHoleToTySigArg numPats) moduleSrc' Nothing -> pure moduleSrc' From 2be2b201afe1777bed809fda0e1579511c04103e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Mon, 20 May 2024 06:44:09 +0200 Subject: [PATCH 29/83] Remove makeDeltaAst breaking tests unrelated to addArgument --- .../src/Development/IDE/GHC/ExactPrint.hs | 7 ++++--- .../src/Development/IDE/Plugin/Plugins/AddArgument.hs | 11 ++++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) 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 c20c216f16..3d6ce16607 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -537,10 +537,11 @@ modifySigWithM queryId f a = do otherSig = case otherIds of [] -> [] #if MIN_VERSION_ghc(9,9,0) - (L epAnn id1:ids) -> [ + (L epAnn id1:ids) -> #else - (L (SrcSpanAnn epAnn span) id1:ids) -> [ + (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) @@ -551,7 +552,7 @@ modifySigWithM queryId f a = do #endif ids'' = ids' & _last %~ first removeTrailingAnns in L annSigD (SigD xsig (TypeSig xTypeSig ids'' (HsWC xHsWc lHsSig))) - ] + ] in pure $ DL.fromList otherSig <> DL.singleton matchedIdSig <> DL.fromList rest _ -> error "multiple ids matched" modifyMatchingSigD (ldecl : rest) = (DL.singleton ldecl <>) <$> modifyMatchingSigD rest 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 184ab93e79..3b4b105986 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 @@ -7,8 +7,7 @@ import Data.Bifunctor (Bifunctor (..)) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.ExactPrint (exactPrint, - makeDeltaAst) +import Development.IDE.GHC.Compat.ExactPrint (exactPrint) import Development.IDE.GHC.Error (spanContainsRange) import Development.IDE.GHC.ExactPrint (genAnchor1, modifyMgMatchesT', @@ -41,6 +40,7 @@ import GHC.Parser.Annotation (TokenLocation (..)) #endif #if !MIN_VERSION_ghc(9,9,0) +import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst) import GHC (SrcSpanAnn' (SrcSpanAnn)) import GHC.Types.SrcLoc (generatedSrcSpan) #endif @@ -120,7 +120,12 @@ appendFinalPatToMatches name = \case addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either PluginError [(T.Text, [TextEdit])] addArgumentAction (ParsedModule _ moduleSrc _ _) range name _typ = do (newSource, _, _) <- runTransformT $ do - (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl (makeDeltaAst moduleSrc) + (moduleSrc', join -> matchedDeclNameMay) <- addNameAsLastArgOfMatchingDecl +#if MIN_VERSION_ghc(9,9,0) + moduleSrc +#else + (makeDeltaAst moduleSrc) +#endif case matchedDeclNameMay of Just (matchedDeclName, numPats) -> modifySigWithM (unLoc matchedDeclName) (addTyHoleToTySigArg numPats) moduleSrc' Nothing -> pure moduleSrc' From d45aa219b4503411444be455e1ab2dd6149d273c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 21 May 2024 16:11:19 +0200 Subject: [PATCH 30/83] Fix 79 code action tests --- .../src/Development/IDE/GHC/ExactPrint.hs | 8 +++++++- .../src/Development/IDE/Plugin/CodeAction.hs | 12 +++++++----- 2 files changed, 14 insertions(+), 6 deletions(-) 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 3d6ce16607..c29a475837 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -161,7 +161,13 @@ getAnnotatedParsedSourceRule recorder = define (cmapWithPrio LogShake recorder) return ([], fmap annotateParsedSource pm) annotateParsedSource :: ParsedModule -> Annotated ParsedSource -annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA (makeDeltaAst ps) 0 +annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA +#if MIN_VERSION_ghc(9,9,0) + ps +#else + (makeDeltaAst ps) +#endif + 0 ------------------------------------------------------------------------------ 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 39b362e20b..9a6c4a8097 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -118,7 +118,6 @@ import GHC (EpaLocation, import GHC.Types.SrcLoc (srcSpanToRealSrcSpan) #endif - ------------------------------------------------------------------------------------------------- -- | Generate code actions. @@ -1651,24 +1650,27 @@ findPositionNoImports ps fileContents = findPositionAfterModuleName :: Annotated ParsedSource -> LocatedA ModuleName -> Maybe Int -findPositionAfterModuleName ps hsmodName' = do +findPositionAfterModuleName ps _hsmodName' = do -- Note that 'where' keyword and comments are not part of the AST. They belongs to -- the exact-print information. To locate it, we need to find the previous AST node, -- calculate the gap between it and 'where', then add them up to produce the absolute -- position of 'where'. lineOffset <- whereKeywordLineOffset -- Calculate the gap before 'where' keyword. +#if MIN_VERSION_ghc(9,9,0) + pure lineOffset +#else + -- The last AST node before 'where' keyword. Might be module name or export list. + let prevSrcSpan = maybe (getLoc _hsmodName') getLoc hsmodExports case prevSrcSpan of UnhelpfulSpan _ -> Nothing (RealSrcSpan prevSrcSpan' _) -> -- add them up produce the absolute location of 'where' keyword Just $ srcLocLine (realSrcSpanEnd prevSrcSpan') + lineOffset +#endif where L _ HsModule {..} = astA ps - -- The last AST node before 'where' keyword. Might be module name or export list. - prevSrcSpan = maybe (getLoc hsmodName') getLoc hsmodExports - -- The relative position of 'where' keyword (in lines, relative to the previous AST node). -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions. whereKeywordLineOffset :: Maybe Int From be89b2db2c25dd4ac1be047732697e9e924cb4da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 21 May 2024 18:43:51 +0200 Subject: [PATCH 31/83] Fix 12 more tests --- .../src/Development/IDE/Plugin/CodeAction.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) 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 9a6c4a8097..05c6a947b2 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -236,7 +236,12 @@ extendImportHandler' ideState ExtendImport {..} Just imp -> do fmap (nfp,) $ liftEither $ rewriteToWEdit df doc $ - extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) + extendImport (T.unpack <$> thingParent) (T.unpack newThing) +#if MIN_VERSION_ghc(9,9,0) + imp +#else + (makeDeltaAst imp) +#endif Nothing -> do let qns = (,) <$> importQual <*> Just (qualifiedImportStyle df) From b8b0f1c73cc32f15d015abb4108784b4b53dcb21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 21 May 2024 18:46:21 +0200 Subject: [PATCH 32/83] Remove co-log-core from allow-newer --- cabal.project | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 50d33d2ab4..ed5980a138 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-19T11:52:03Z +index-state: 2024-05-21T16:36:52Z 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: - co-log-core:base, constraints-extras:base, constraints-extras:template-haskell, dependent-map:containers, From 79b6ebac8050dc638f54bb3af6032835a481483a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 21 May 2024 19:15:27 +0200 Subject: [PATCH 33/83] Fix 21 more tests --- .../src/Development/IDE/Plugin/CodeAction.hs | 8 ++++++++ 1 file changed, 8 insertions(+) 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 05c6a947b2..03799b7765 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1232,7 +1232,11 @@ suggestAddRecordFieldImport exportsMap df ps fileContents Diagnostic {..} -- | Suggests a constraint for a declaration for which a constraint is missing. suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] +#if MIN_VERSION_ghc(9,9,0) +suggestConstraint df parsedModule diag@Diagnostic {..} +#else suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} +#endif | Just missingConstraint <- findMissingConstraint _message = let codeAction = if _message =~ ("the type signature for:" :: String) then suggestFunctionConstraint df parsedModule @@ -1355,7 +1359,11 @@ suggestFunctionConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing -- | Suggests the removal of a redundant constraint for a type signature. removeRedundantConstraints :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] +#if MIN_VERSION_ghc(9,9,0) +removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..} +#else removeRedundantConstraints df (makeDeltaAst -> L _ HsModule {hsmodDecls}) Diagnostic{..} +#endif -- • Redundant constraint: Eq a -- • In the type signature for: -- foo :: forall a. Eq a => a -> a From a9d4b4b4969cad108b85aecbffba29242969c283 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Wed, 22 May 2024 08:24:22 +0200 Subject: [PATCH 34/83] Fix 8 import disambiguation tests --- .../src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) 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 70a76ea73a..c65978e5c6 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 @@ -523,7 +523,7 @@ hideSymbol symbol lidecl@(L loc ImportDecl{..}) = case ideclImportList of Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing Just (EverythingBut, hides) -> Rewrite (locA loc) $ extendHiding symbol lidecl (Just hides) - Just (Exactly, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl imports + Just (Exactly, imports) -> Rewrite (locA loc) $ deleteFromImport symbol lidecl $ setEntryDP (makeDeltaAst imports) (SameLine 1) #else case ideclHiding of Nothing -> Rewrite (locA loc) $ extendHiding symbol lidecl Nothing @@ -599,11 +599,10 @@ deleteFromImport (T.pack -> symbol) (L l idecl) (L lieLoc lies) _ = do L l $ idecl #if MIN_VERSION_ghc(9,5,0) - { ideclImportList = Just (Exactly, edited) + { ideclImportList = Just (Exactly, edited) } #else - { ideclHiding = Just (False, edited) + { ideclHiding = Just (False, edited) } #endif - } pure lidecl' where deletedLies = From 5a4405da458ea7e2d5dd0827a74608a5cd5fe133 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 22 May 2024 16:53:39 +0530 Subject: [PATCH 35/83] fix windows ghcide tests --- ghcide/src/Development/IDE/GHC/Compat.hs | 2 +- ghcide/test/exe/CompletionTests.hs | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index b377fec0c7..14e6b1eb1f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -515,7 +515,7 @@ data GhcVersion | GHC96 | GHC98 | GHC910 - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Enum) ghcVersionStr :: String ghcVersionStr = VERSION_ghc diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index 590f0b707a..99008f13ec 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -33,6 +33,7 @@ import Test.Hls.FileSystem (file, text) import Test.Hls.Util (knownBrokenOnWindows) import Test.Tasty import Test.Tasty.HUnit +import TestUtils tests :: TestTree @@ -217,7 +218,7 @@ localCompletionTests = [ nonLocalCompletionTests :: [TestTree] nonLocalCompletionTests = - [ brokenForWinGhc $ completionTest + [ brokenForWinOldGhc $ completionTest "variable" ["module A where", "f = hea"] (Position 1 7) @@ -276,6 +277,7 @@ nonLocalCompletionTests = ] where brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason" + brokenForWinOldGhc = knownBrokenFor (BrokenSpecific Windows [GHC92 .. GHC98]) "Windows (GHC <= 9.8) has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [ @@ -352,7 +354,7 @@ packageCompletionTests = , "'GHC.Exts" ] ++ (["'GHC.IsList" | ghcVersion >= GHC94])) - , testSessionEmpty "Map" $ do + , testSessionEmptyWithCradle "Map" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, containers, A]}}" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", From 5bf9e7d684cbc06c8184be9a99ca1846ae8a450b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 23 May 2024 07:17:27 +0200 Subject: [PATCH 36/83] Fix adding argument to function body --- .../src/Development/IDE/GHC/ExactPrint.hs | 6 +++--- .../src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 2 -- 2 files changed, 3 insertions(+), 5 deletions(-) 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 c29a475837..12d49d4ac6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -448,8 +448,8 @@ graftDecls dst decs0 = Graft $ \dflags a -> do -- For example, if you would like to move a where-clause-defined variable to the same -- level as its parent HsDecl, you could use this function. -- --- When matching declaration is found in the sub-declarations of `a`, `Just r` is also returned with the new `a`. If --- not declaration matched, then `Nothing` is returned. +-- When matching declaration is found in the sub-declarations of `a`, `Just r` is also returned with the new `a`. +-- If no declaration matched, then `Nothing` is returned. modifySmallestDeclWithM :: forall a m r. (HasDecls a, Monad m) => @@ -462,7 +462,7 @@ modifySmallestDeclWithM validSpan f a = do modifyMatchingDecl (ldecl@(L src _) : rest) = TransformT (lift $ validSpan $ locA src) >>= \case True -> do - (decs', r) <- f ldecl + (decs', r) <- f (makeDeltaAst ldecl) pure (DL.fromList decs' <> DL.fromList rest, Just r) False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a 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 c65978e5c6..64ebf05f4c 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 @@ -77,11 +77,9 @@ 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 From 45ee5ea5ed49b1385ca316839083796908766875 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 23 May 2024 12:35:12 +0200 Subject: [PATCH 37/83] update retrie commit, progress in add argument tests --- cabal.project | 2 +- .../src/Development/IDE/GHC/ExactPrint.hs | 4 +- .../IDE/Plugin/Plugins/AddArgument.hs | 48 ++++++++++++------- 3 files changed, 35 insertions(+), 19 deletions(-) diff --git a/cabal.project b/cabal.project index ed5980a138..b22a35811e 100644 --- a/cabal.project +++ b/cabal.project @@ -48,7 +48,7 @@ if impl(ghc >= 9.9) source-repository-package type:git location: https://github.com/wz1000/retrie.git - tag: 7bf599856f055aefa86a6db10c12dcbc10c7130a + tag: 2f089092a563b06eccf196751782f1d70000d589 constraints: lens >= 5.3.2, haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, 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 12d49d4ac6..2f1426d79d 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -514,7 +514,7 @@ removeTrailingAnns spanAnnN = spanAnnN -- + foo :: Bool modifySigWithM :: forall a m. - (HasDecls a, Monad m) => + (HasDecls a, Monad m, ExactPrint a) => IdP GhcPs -> (LHsSigType GhcPs -> LHsSigType GhcPs) -> a -> @@ -562,7 +562,7 @@ modifySigWithM queryId f a = do in pure $ DL.fromList otherSig <> DL.singleton matchedIdSig <> DL.fromList rest _ -> error "multiple ids matched" modifyMatchingSigD (ldecl : rest) = (DL.singleton ldecl <>) <$> modifyMatchingSigD rest - modifyDeclsT (fmap DL.toList . modifyMatchingSigD) a + modifyDeclsT (fmap DL.toList . modifyMatchingSigD) $ makeDeltaAst a genAnchor0 :: Anchor genAnchor0 = generatedAnchor m0 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 3b4b105986..d2144c622b 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 @@ -7,21 +7,19 @@ import Data.Bifunctor (Bifunctor (..)) import Data.Either.Extra (maybeToEither) import qualified Data.Text as T import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.ExactPrint (exactPrint) import Development.IDE.GHC.Error (spanContainsRange) -import Development.IDE.GHC.ExactPrint (genAnchor1, - modifyMgMatchesT', +import Development.IDE.GHC.ExactPrint (modifyMgMatchesT', modifySigWithM, modifySmallestDeclWithM) import Development.IDE.Plugin.Plugins.Diagnostic -import GHC (EpAnn (..), - SrcSpanAnnA, +import GHC.Parser.Annotation (SrcSpanAnnA, SrcSpanAnnN, - emptyComments, + noAnn) import Ide.Plugin.Error (PluginError (PluginInternalError)) import Ide.PluginUtils (makeDiffTextEdit) import Language.Haskell.GHC.ExactPrint (TransformT (..), + exactPrint, noAnnSrcSpanDP1, runTransformT) import Language.LSP.Protocol.Types @@ -29,9 +27,9 @@ 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) +import GHC.Parser.Annotation (IsUnicodeSyntax (..), + TrailingAnn (..)) +import Language.Haskell.GHC.ExactPrint (d1) #endif #if MIN_VERSION_ghc(9,4,0) && !MIN_VERSION_ghc(9,9,0) @@ -41,12 +39,15 @@ import GHC.Parser.Annotation (TokenLocation (..)) #if !MIN_VERSION_ghc(9,9,0) import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst) -import GHC (SrcSpanAnn' (SrcSpanAnn)) +import Development.IDE.GHC.ExactPrint (genAnchor1) +import GHC.Parser.Annotation (EpAnn (..), SrcSpanAnn' (..), emptyComments) import GHC.Types.SrcLoc (generatedSrcSpan) #endif #if MIN_VERSION_ghc(9,9,0) -import GHC (EpUniToken (..)) +import GHC (EpUniToken (..), + IsUnicodeSyntax (NormalSyntax)) +import Language.Haskell.GHC.ExactPrint (d1) #endif -- When GHC tells us that a variable is not bound, it will tell us either: @@ -154,19 +155,34 @@ hsTypeFromFunTypeAsList (args, res) = -- 0 `foo :: ()` => foo :: _ -> () -- 2 `foo :: FunctionTySyn` => foo :: FunctionTySyn -- 1 `foo :: () -> () -> Int` => foo :: () -> _ -> () -> Int -addTyHoleToTySigArg :: Int -> LHsSigType GhcPs -> (LHsSigType GhcPs) +addTyHoleToTySigArg :: Int -> LHsSigType GhcPs -> LHsSigType GhcPs addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) = let (args, res) = hsTypeToFunTypeAsList lsigTy #if MIN_VERSION_ghc(9,9,0) - wildCardAnn = EpAnn genAnchor1 (AnnListItem []) emptyComments - newArg = (noAnn, noExtField, HsUnrestrictedArrow NoEpUniTok, L wildCardAnn $ HsWildCardTy noExtField) + wildCardAnn = noAnnSrcSpanDP1 + newArg = + ( noAnn + , noExtField + , HsUnrestrictedArrow (EpUniTok d1 NormalSyntax) + , 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) + newArg = + ( SrcSpanAnn mempty generatedSrcSpan + , noAnn + , HsUnrestrictedArrow (L arrowAnn HsNormalTok) + , L wildCardAnn $ HsWildCardTy noExtField + ) #else wildCardAnn = SrcSpanAnn (EpAnn genAnchor1 (AnnListItem [AddRarrowAnn d1]) emptyComments) generatedSrcSpan - newArg = (SrcSpanAnn mempty generatedSrcSpan, noAnn, HsUnrestrictedArrow NormalSyntax, L wildCardAnn $ HsWildCardTy noExtField) + newArg = + ( SrcSpanAnn mempty generatedSrcSpan + , noAnn + , HsUnrestrictedArrow NormalSyntax + , L wildCardAnn $ HsWildCardTy noExtField + ) #endif -- NOTE if the location that the argument wants to be placed at is not one more than the number of arguments -- in the signature, then we return the original type signature. From e7b14fc2c5e36ac2b4b137811385e6d8c8cfe23a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 23 May 2024 13:19:04 +0200 Subject: [PATCH 38/83] Fix few stylish-haskell parse errors --- .../src/Ide/Plugin/ExplicitFields.hs | 7 +++---- .../src/Ide/Plugin/OverloadedRecordDot.hs | 5 ++--- .../src/Development/IDE/Plugin/Plugins/AddArgument.hs | 8 ++++---- plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs | 5 +++-- 4 files changed, 12 insertions(+), 13 deletions(-) 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 9545865efc..4036676834 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 @@ -181,11 +181,10 @@ collectRecordsRule recorder = getRecords :: TcModuleResult -> [RecordInfo] #if __GLASGOW_HASKELL__ < 910 -getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = +getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = collectRecords valBinds #else -getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_, _)) = +getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_, _)) = collectRecords valBinds #endif - collectRecords valBinds collectNamesRule :: Rules () collectNamesRule = defineNoDiagnostics mempty $ \CollectNames nfp -> runMaybeT $ do @@ -196,7 +195,7 @@ collectNamesRule = defineNoDiagnostics mempty $ \CollectNames nfp -> runMaybeT $ -- in the variable usage analysis. getNames :: TcModuleResult -> UniqFM Name [Name] #if __GLASGOW_HASKELL__ < 910 -getNames (tmrRenamed -> (group,_,_,_)) = collectNames group +getNames (tmrRenamed -> (group,_,_,_)) = collectNames group #else getNames (tmrRenamed -> (group,_,_,_,_)) = collectNames group #endif 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 e7e365ac24..3361560820 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 @@ -251,11 +251,10 @@ collectRecSelsRule recorder = define (cmapWithPrio LogShake recorder) $ getEnabledExtensions = getExtensions . tmrParsed getRecordSelectors :: TcModuleResult -> [RecordSelectorExpr] #if __GLASGOW_HASKELL__ >= 910 - getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_,_)) = + getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_,_)) = collectRecordSelectors valBinds #else - getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = + getRecordSelectors (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) = collectRecordSelectors valBinds #endif - collectRecordSelectors valBinds rewriteRange :: PositionMapping -> RecordSelectorExpr -> Maybe RecordSelectorExpr rewriteRange pm recSel = 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 d2144c622b..41ba10d033 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 @@ -13,9 +13,7 @@ import Development.IDE.GHC.ExactPrint (modifyMgMatchesT', modifySmallestDeclWithM) import Development.IDE.Plugin.Plugins.Diagnostic import GHC.Parser.Annotation (SrcSpanAnnA, - SrcSpanAnnN, - - noAnn) + SrcSpanAnnN, noAnn) import Ide.Plugin.Error (PluginError (PluginInternalError)) import Ide.PluginUtils (makeDiffTextEdit) import Language.Haskell.GHC.ExactPrint (TransformT (..), @@ -40,7 +38,9 @@ import GHC.Parser.Annotation (TokenLocation (..)) #if !MIN_VERSION_ghc(9,9,0) import Development.IDE.GHC.Compat.ExactPrint (makeDeltaAst) import Development.IDE.GHC.ExactPrint (genAnchor1) -import GHC.Parser.Annotation (EpAnn (..), SrcSpanAnn' (..), emptyComments) +import GHC.Parser.Annotation (EpAnn (..), + SrcSpanAnn' (..), + emptyComments) import GHC.Types.SrcLoc (generatedSrcSpan) #endif diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 34b92a68cc..d76d749b77 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -748,10 +748,11 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} #if MIN_VERSION_ghc(9,5,0) ideclImportList = Nothing ideclExt = GHCGHC.XImportDeclPass + { ideclAnn = #if MIN_VERSION_ghc(9,9,0) - { ideclAnn = GHCGHC.noAnn + GHCGHC.noAnn #else - { ideclAnn = GHCGHC.EpAnnNotUsed + GHCGHC.EpAnnNotUsed #endif , ideclSourceText = ideclSourceSrc , ideclImplicit = ideclImplicit From 80dd20f189094c753ce66671684e83be4419e4d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 26 May 2024 19:36:21 +0200 Subject: [PATCH 39/83] Fix remaining redundant constraint tests --- .../src/Development/IDE/Plugin/CodeAction/ExactPrint.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) 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 64ebf05f4c..422d564103 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 @@ -131,10 +131,12 @@ removeConstraint :: removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" where go :: LHsType GhcPs -> Rewrite -#if !MIN_VERSION_ghc(9,4,0) - go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do -#else +#if MIN_VERSION_ghc(9,9,0) + go lHsType@(makeDeltaAst -> L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA lHsType) $ \_ -> do +#elif MIN_VERSION_ghc(9,4,0) go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do +#else + go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do #endif let ctxt' = filter (not . toRemove) ctxt removeStuff = (toRemove <$> headMaybe ctxt) == Just True From ba58c22fa79f96e5dc02204e9b54218bd9a4242b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 28 May 2024 07:49:32 +0200 Subject: [PATCH 40/83] Remove allow-newer for constraint-extras --- cabal.project | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index b22a35811e..33f410e5c6 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-21T16:36:52Z +index-state: 2024-05-28T03:01:07Z tests: True test-show-details: direct @@ -53,8 +53,6 @@ if impl(ghc >= 9.9) lens >= 5.3.2, haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, allow-newer: - constraints-extras:base, - constraints-extras:template-haskell, dependent-map:containers, entropy:base, entropy:directory, From d955f9a3d076af1089c26d6026f1278e27a10beb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 28 May 2024 07:50:55 +0200 Subject: [PATCH 41/83] Fix warnings after master merge --- ghcide/src/Development/IDE/Main.hs | 1 - ghcide/test/exe/BootTests.hs | 1 - ghcide/test/exe/ClientSettingsTests.hs | 1 - ghcide/test/exe/Config.hs | 9 --------- ghcide/test/exe/CradleTests.hs | 12 +++++------ ghcide/test/exe/ExceptionTests.hs | 1 - ghcide/test/exe/IfaceTests.hs | 1 - ghcide/test/exe/Main.hs | 20 ++----------------- ghcide/test/exe/ReferenceTests.hs | 2 +- ghcide/test/exe/THTests.hs | 4 +--- ghcide/test/exe/TestUtils.hs | 8 +------- ghcide/test/exe/UnitTests.hs | 10 +++------- haskell-language-server.cabal | 6 ------ hls-test-utils/src/Test/Hls/Util.hs | 4 +--- .../src/Ide/Plugin/ModuleName.hs | 5 ++--- 15 files changed, 17 insertions(+), 68 deletions(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 0c1c740596..97ce064844 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -24,7 +24,6 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as J import Data.Coerce (coerce) import Data.Default (Default (def)) -import Data.Foldable (traverse_) import Data.Hashable (hashed) import qualified Data.HashMap.Strict as HashMap import Data.List.Extra (intercalate, diff --git a/ghcide/test/exe/BootTests.hs b/ghcide/test/exe/BootTests.hs index 078281d391..06c05ba9b6 100644 --- a/ghcide/test/exe/BootTests.hs +++ b/ghcide/test/exe/BootTests.hs @@ -17,7 +17,6 @@ import Language.LSP.Protocol.Types hiding mkRange) import Language.LSP.Test import System.FilePath (()) -import Test.Hls.FileSystem (toAbsFp) import Test.Tasty import Test.Tasty.HUnit diff --git a/ghcide/test/exe/ClientSettingsTests.hs b/ghcide/test/exe/ClientSettingsTests.hs index 698e0af165..c947fdc5ee 100644 --- a/ghcide/test/exe/ClientSettingsTests.hs +++ b/ghcide/test/exe/ClientSettingsTests.hs @@ -18,7 +18,6 @@ import Language.LSP.Test import Test.Hls (testConfigCaps, waitForProgressDone) import Test.Tasty -import TestUtils tests :: TestTree tests = testGroup "client settings handling" diff --git a/ghcide/test/exe/Config.hs b/ghcide/test/exe/Config.hs index 84b3664def..d77a8399be 100644 --- a/ghcide/test/exe/Config.hs +++ b/ghcide/test/exe/Config.hs @@ -33,7 +33,6 @@ import Control.Lens.Setter ((.~)) import Data.Foldable (traverse_) import Data.Function ((&)) import qualified Data.Text as T -import Development.IDE (Pretty) import Development.IDE.Test (canonicalizeUri) import Ide.Types (defaultPluginDescriptor) import qualified Language.LSP.Protocol.Lens as L @@ -90,20 +89,12 @@ testWithExtraFiles testName dirName action = testCase testName $ runWithExtraFil runInDir :: FilePath -> Session a -> IO a runInDir fs = runSessionWithServer def dummyPlugin fs -testSession' :: TestName -> (FilePath -> Session ()) -> TestTree -testSession' name = testCase name . run' - run :: Session a -> IO a run = runSessionWithTestConfig def { testDirLocation = Right (mkIdeTestFs []) , testPluginDescriptor = dummyPlugin } . const -run' :: (FilePath -> Session a) -> IO a -run' = runSessionWithTestConfig def - { testDirLocation = Right (mkIdeTestFs []) - , testPluginDescriptor = dummyPlugin } - pattern R :: UInt -> UInt -> UInt -> UInt -> Range pattern R x y x' y' = Range (Position x y) (Position x' y') diff --git a/ghcide/test/exe/CradleTests.hs b/ghcide/test/exe/CradleTests.hs index ca922d53cc..cdfbb06ea2 100644 --- a/ghcide/test/exe/CradleTests.hs +++ b/ghcide/test/exe/CradleTests.hs @@ -3,17 +3,23 @@ module CradleTests (tests) where +import Config (checkDefs, mkL, runInDir, + runWithExtraFiles, + testWithDummyPluginEmpty') import Control.Applicative.Combinators +import Control.Lens ((^.)) import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Development.IDE.GHC.Compat (GhcVersion (..)) import Development.IDE.GHC.Util +import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..)) import Development.IDE.Test (expectDiagnostics, expectDiagnosticsWithTags, expectNoMoreDiagnostics, isReferenceReady, waitForAction) import Development.IDE.Types.Location +import GHC.TypeLits (symbolVal) import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types hiding @@ -24,12 +30,6 @@ import Language.LSP.Protocol.Types hiding import Language.LSP.Test import System.FilePath import System.IO.Extra hiding (withTempDir) --- import Test.QuickCheck.Instances () -import Config -import Config (checkDefs, mkL) -import Control.Lens ((^.)) -import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..)) -import GHC.TypeLits (symbolVal) import Test.Hls (ignoreForGhcVersions) import Test.Tasty import Test.Tasty.HUnit diff --git a/ghcide/test/exe/ExceptionTests.hs b/ghcide/test/exe/ExceptionTests.hs index 6c08f7ecba..ec173993a0 100644 --- a/ghcide/test/exe/ExceptionTests.hs +++ b/ghcide/test/exe/ExceptionTests.hs @@ -31,7 +31,6 @@ import LogType (Log (..)) import Test.Hls (TestConfig (testDisableDefaultPlugin, testPluginDescriptor), runSessionWithTestConfig, testCheckProject, - testConfigSession, waitForProgressDone) import Test.Tasty import Test.Tasty.HUnit diff --git a/ghcide/test/exe/IfaceTests.hs b/ghcide/test/exe/IfaceTests.hs index 90d27c445b..330d372d73 100644 --- a/ghcide/test/exe/IfaceTests.hs +++ b/ghcide/test/exe/IfaceTests.hs @@ -18,7 +18,6 @@ import Language.LSP.Test import System.Directory import System.FilePath import System.IO.Extra hiding (withTempDir) -import Test.Hls.FileSystem (toAbsFp) import Test.Tasty import Test.Tasty.HUnit diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 558115fc24..6c8091840d 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -29,14 +29,8 @@ module Main (main) where --- import Test.QuickCheck.Instances () -import Data.Function ((&)) + import qualified HieDbRetry -import Ide.Logger (Pretty (pretty), - Priority (Debug), - WithPriority (WithPriority, priority), - cfilter, cmapWithPrio, - makeDefaultStderrRecorder) import Test.Tasty import Test.Tasty.Ingredients.Rerun @@ -48,7 +42,6 @@ import CompletionTests import CPPTests import CradleTests import DependentFileTest -import Development.IDE (LoggingColumn (..)) import DiagnosticTests import ExceptionTests import FindDefinitionAndHoverTests @@ -74,15 +67,6 @@ import WatchedFileTests main :: IO () main = do - docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [ThreadIdColumn, PriorityColumn, DataColumn]) - - let docWithFilteredPriorityRecorder = - docWithPriorityRecorder - & cfilter (\WithPriority{ priority } -> priority >= Debug) - - let recorder = docWithFilteredPriorityRecorder - & cmapWithPrio pretty - -- We mess with env vars so run single-threaded. defaultMainWithRerun $ testGroup "ghcide" [ OpenCloseTest.tests @@ -99,7 +83,7 @@ main = do , THTests.tests , SymlinkTests.tests , SafeTests.tests - , UnitTests.tests recorder + , UnitTests.tests , HaddockTests.tests , PositionMappingTests.tests , WatchedFileTests.tests diff --git a/ghcide/test/exe/ReferenceTests.hs b/ghcide/test/exe/ReferenceTests.hs index f15606ac9c..bc69a8fdbf 100644 --- a/ghcide/test/exe/ReferenceTests.hs +++ b/ghcide/test/exe/ReferenceTests.hs @@ -34,7 +34,7 @@ import Test.Hls (FromServerMessage' (..), SMethod (..), TCustomMessage (..), TNotificationMessage (..)) -import Test.Hls.FileSystem (copyDir, toAbsFp) +import Test.Hls.FileSystem (copyDir) import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit diff --git a/ghcide/test/exe/THTests.hs b/ghcide/test/exe/THTests.hs index 61c2ef49f3..42a5650ed7 100644 --- a/ghcide/test/exe/THTests.hs +++ b/ghcide/test/exe/THTests.hs @@ -13,8 +13,6 @@ import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..), SemanticTokensEdit (..), mkRange) import Language.LSP.Test import System.FilePath -import Test.Hls (waitForAllProgressDone, - waitForProgressBegin) import Test.Tasty import Test.Tasty.HUnit @@ -180,7 +178,7 @@ thLinkingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do -- modify b too let bSource' = T.unlines $ init (T.lines bSource) ++ ["$th"] changeDoc bdoc [TextDocumentContentChangeEvent . InR $ TextDocumentContentChangeWholeDocument bSource'] - waitForDiagnostics + _ <- waitForDiagnostics expectCurrentDiagnostics bdoc [(DiagnosticSeverity_Warning, (4,1), "Top-level binding")] diff --git a/ghcide/test/exe/TestUtils.hs b/ghcide/test/exe/TestUtils.hs index 87c129ba2f..7d40d64c49 100644 --- a/ghcide/test/exe/TestUtils.hs +++ b/ghcide/test/exe/TestUtils.hs @@ -2,19 +2,15 @@ module TestUtils where -import Control.Concurrent.Async -import Control.Exception (bracket_, finally) +import Control.Exception (bracket_) import Data.Foldable import Data.Maybe import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) -import qualified Development.IDE.Main as IDE import Development.IDE.Test (configureCheckProject, expectNoMoreDiagnostics) import Development.IDE.Test.Runfiles import Development.IDE.Types.Location import Development.Shake (getDirectoryFilesIO) -import Ide.Logger (Recorder, WithPriority, - cmapWithPrio) import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..), SemanticTokenRelative (..), @@ -26,13 +22,11 @@ import System.Environment.Blank (getEnv, setEnv, unsetEnv) import System.FilePath import System.Info.Extra (isMac, isWindows) import qualified System.IO.Extra -import System.Process.Extra (createPipe) import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit import Config (lspTestCaps) -import LogType run :: Session a -> IO a diff --git a/ghcide/test/exe/UnitTests.hs b/ghcide/test/exe/UnitTests.hs index 1e8ac4214a..68e6f3e1f0 100644 --- a/ghcide/test/exe/UnitTests.hs +++ b/ghcide/test/exe/UnitTests.hs @@ -10,13 +10,11 @@ import Data.List.Extra import Data.String (IsString (fromString)) import qualified Data.Text as T import Development.IDE.Core.FileStore (getModTime) -import qualified Development.IDE.Main as IDE import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location import qualified FuzzySearch -import Ide.Logger (Recorder, WithPriority, - cmapWithPrio) +import Ide.Logger (Recorder, WithPriority) import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types import Language.LSP.Protocol.Message @@ -26,7 +24,6 @@ import Language.LSP.Protocol.Types hiding SemanticTokensEdit (..), mkRange) import Language.LSP.Test -import LogType (Log (..)) import Network.URI import qualified Progress import System.IO.Extra hiding (withTempDir) @@ -37,11 +34,10 @@ import Test.Hls (IdeState, def, import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit -import TestUtils import Text.Printf (printf) -tests :: Recorder (WithPriority Log) -> TestTree -tests recorder = do +tests :: TestTree +tests = do testGroup "Unit" [ testCase "empty file path does NOT work with the empty String literal" $ uriToFilePath' (fromNormalizedUri $ filePathToUri' "") @?= Just "." diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index e230070907..4dadf75a17 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -637,7 +637,6 @@ library hls-retrie-plugin , base >=4.12 && <5 , bytestring , containers - , directory , extra , ghc , ghcide == 2.8.0.0 @@ -654,7 +653,6 @@ library hls-retrie-plugin , text , transformers , unordered-containers - , filepath default-extensions: DataKinds @@ -844,7 +842,6 @@ library hls-module-name-plugin , aeson , base >=4.12 && <5 , containers - , directory , filepath , ghcide == 2.8.0.0 , hls-plugin-api == 2.8.0.0 @@ -1829,7 +1826,6 @@ test-suite hls-notes-plugin-tests main-is: NotesTest.hs build-depends: , base - , directory , filepath , haskell-language-server:hls-notes-plugin , hls-test-utils == 2.8.0.0 @@ -2099,7 +2095,6 @@ test-suite ghcide-tests build-depends: , aeson - , async , base , containers , data-default @@ -2196,7 +2191,6 @@ executable ghcide-bench bytestring, containers, data-default, - directory, extra, filepath, hls-plugin-api, diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index 92bada04f7..8ba95368fd 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -55,7 +55,6 @@ import Data.Bool (bool) import Data.Default import Data.List.Extra (find) import Data.Proxy -import qualified Data.Set as Set import qualified Data.Text as T import Development.IDE (GhcVersion (..), ghcVersion) import qualified Language.LSP.Protocol.Lens as L @@ -71,8 +70,7 @@ import System.Time.Extra (Seconds, sleep) import Test.Tasty (TestTree) import Test.Tasty.ExpectedFailure (expectFailBecause, ignoreTestBecause) -import Test.Tasty.HUnit (Assertion, assertFailure, - (@?=)) +import Test.Tasty.HUnit (assertFailure) noLiteralCaps :: ClientCapabilities noLiteralCaps = def & L.textDocument ?~ textDocumentCaps diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index b185240ade..88eb820194 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -59,11 +59,10 @@ import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server import Language.LSP.VFS (virtualFileText) -import System.FilePath (dropExtension, - isAbsolute, normalise, +import System.FilePath (dropExtension, normalise, pathSeparator, splitDirectories, - takeFileName, ()) + takeFileName) -- |Plugin descriptor descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState From 0655fcc94672c445e07d166b3132a836b9331666 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 28 May 2024 06:10:20 +0200 Subject: [PATCH 42/83] Fix most add argument tests except for one --- .../src/Development/IDE/GHC/ExactPrint.hs | 4 ++-- .../IDE/Plugin/Plugins/AddArgument.hs | 17 ++++++++++++----- 2 files changed, 14 insertions(+), 7 deletions(-) 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 2f1426d79d..4caae00bf1 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -462,7 +462,7 @@ modifySmallestDeclWithM validSpan f a = do modifyMatchingDecl (ldecl@(L src _) : rest) = TransformT (lift $ validSpan $ locA src) >>= \case True -> do - (decs', r) <- f (makeDeltaAst ldecl) + (decs', r) <- f ldecl pure (DL.fromList decs' <> DL.fromList rest, Just r) False -> first (DL.singleton ldecl <>) <$> modifyMatchingDecl rest modifyDeclsT' (fmap (first DL.toList) . modifyMatchingDecl) a @@ -607,7 +607,7 @@ modifyMgMatchesT' :: modifyMgMatchesT' (MG xMg (L locMatches matches)) f def combineResults = do (unzip -> (matches', rs)) <- mapM f matches r' <- TransformT $ lift $ foldM combineResults def rs - pure $ (MG xMg (L locMatches matches'), r') + pure (MG xMg (L locMatches matches'), r') #else modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults = do (unzip -> (matches', rs)) <- mapM f matches 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 41ba10d033..ed2d3b4a73 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 @@ -45,11 +45,13 @@ import GHC.Types.SrcLoc (generatedSrcSpan) #endif #if MIN_VERSION_ghc(9,9,0) -import GHC (EpUniToken (..), +import GHC (DeltaPos (..), + EpUniToken (..), IsUnicodeSyntax (NormalSyntax)) -import Language.Haskell.GHC.ExactPrint (d1) +import Language.Haskell.GHC.ExactPrint (d1, setEntryDP) #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) @@ -74,15 +76,20 @@ plugin parsedModule Diagnostic {_message, _range} -- returning how many patterns there were in this match prior to the transformation: -- addArgToMatch "foo" `bar arg1 arg2 = ...` -- => (`bar arg1 arg2 foo = ...`, 2) -addArgToMatch :: T.Text -> GenLocated l (Match GhcPs body) -> (GenLocated l (Match GhcPs body), Int) +addArgToMatch :: T.Text -> GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))) -> (GenLocated l (Match GhcPs (LocatedA (HsExpr GhcPs))), 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) + newPat = L noAnnSrcSpanDP1 $ VarPat NoExtField $ L noAnn unqualName + -- The intention is to move `= ...` (right-hand side with equals) to the right so there's 1 space between + -- the newly added pattern and the rest + indentRhs :: GRHSs GhcPs (LocatedA (HsExpr GhcPs)) -> GRHSs GhcPs (LocatedA (HsExpr GhcPs)) + indentRhs rhs@GRHSs{grhssGRHSs} = rhs {grhssGRHSs = fmap (`setEntryDP` (SameLine 1)) grhssGRHSs } #else newPat = L (noAnnSrcSpanDP1 generatedSrcSpan) $ VarPat NoExtField (noLocA unqualName) + indentRhs = id #endif - in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) rhs), Prelude.length pats) + in (L locMatch (Match xMatch ctxMatch (pats <> [newPat]) (indentRhs 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. -- Also return: From 625190df15a22a4feac978c4022644d3d6bd43f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 28 May 2024 09:42:21 +0200 Subject: [PATCH 43/83] Remove dependent-map from allow-newer --- cabal.project | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 33f410e5c6..f900033f91 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-05-28T03:01:07Z +index-state: 2024-05-28T06:12:34Z 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: - dependent-map:containers, entropy:base, entropy:directory, entropy:filepath, From 6f60029ff2a3a7d9d5210d4b0754bd25424718fc Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 28 May 2024 10:04:49 +0100 Subject: [PATCH 44/83] Try removing some allow-newers from lsp --- cabal.project | 3 --- 1 file changed, 3 deletions(-) diff --git a/cabal.project b/cabal.project index f900033f91..51d66ec2b8 100644 --- a/cabal.project +++ b/cabal.project @@ -61,8 +61,5 @@ if impl(ghc >= 9.9) haddock-library:containers, hiedb:base, hiedb:ghc, - quickcheck-instances:base, - quickcheck-instances:containers, - uuid-types:template-haskell, else benchmarks: True From c4e607eb4c23df59c7d81e3542506234f229b4d8 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 28 May 2024 10:07:00 +0100 Subject: [PATCH 45/83] Ormolu is updated, add links for other tool dependencies --- cabal.project | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 51d66ec2b8..dc68cfe20a 100644 --- a/cabal.project +++ b/cabal.project @@ -51,7 +51,12 @@ if impl(ghc >= 9.9) tag: 2f089092a563b06eccf196751782f1d70000d589 constraints: lens >= 5.3.2, - haskell-language-server -stylishHaskell -ormolu -fourmolu -floskell -hlint, + -- See + -- https://github.com/haskell/stylish-haskell/issues/479 + -- https://github.com/fourmolu/fourmolu/issues/412 + -- https://github.com/ennocramer/floskell/issues/81 + -- https://github.com/ndmitchell/hlint/pull/1594 + haskell-language-server -stylishHaskell -fourmolu -floskell -hlint, allow-newer: entropy:base, entropy:directory, From cfdf0d7e09089054bf1f67fbfb52e01888b9b7ae Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 28 May 2024 10:10:33 +0100 Subject: [PATCH 46/83] Revert "Try removing some allow-newers from lsp" This reverts commit 6f60029ff2a3a7d9d5210d4b0754bd25424718fc. --- cabal.project | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cabal.project b/cabal.project index dc68cfe20a..13e093a35a 100644 --- a/cabal.project +++ b/cabal.project @@ -66,5 +66,8 @@ if impl(ghc >= 9.9) haddock-library:containers, hiedb:base, hiedb:ghc, + quickcheck-instances:base, + quickcheck-instances:containers, + uuid-types:template-haskell, else benchmarks: True From ebf876e14b4ad4d62619660630863220e8313c29 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 28 May 2024 10:25:03 +0100 Subject: [PATCH 47/83] Try this --- cabal.project | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal.project b/cabal.project index 13e093a35a..1326acf257 100644 --- a/cabal.project +++ b/cabal.project @@ -66,6 +66,7 @@ if impl(ghc >= 9.9) haddock-library:containers, hiedb:base, hiedb:ghc, + -- These can be removed when we get a new lsp release quickcheck-instances:base, quickcheck-instances:containers, uuid-types:template-haskell, From 7a8b11653ae08255bd2bda5aad7bd560745ec61e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 28 May 2024 16:43:30 +0200 Subject: [PATCH 48/83] Fix all gadt plugin and most class plugin tests, enable 2 tests for ghc 9.4+ --- hls-test-utils/src/Test/Hls.hs | 2 - .../src/Ide/Plugin/Class/ExactPrint.hs | 51 ++++++++++++------- plugins/hls-class-plugin/test/Main.hs | 8 ++- .../test/testdata/T5.expected.hs | 2 +- plugins/hls-class-plugin/test/testdata/T5.hs | 2 +- plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs | 24 ++++----- 6 files changed, 47 insertions(+), 42 deletions(-) diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index cb566078b5..9c9ae177dc 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -87,7 +87,6 @@ import Development.IDE (IdeState, LoggingColumn (ThreadIdColumn), defaultLayoutOptions, layoutPretty, renderStrict) -import qualified Development.IDE.LSP.Notifications as Notifications import Development.IDE.Main hiding (Log) import qualified Development.IDE.Main as IDEMain import Development.IDE.Plugin.Test (TestRequest (GetBuildKeysBuilt, WaitForIdeRule, WaitForShakeQueue), @@ -105,7 +104,6 @@ import Ide.Logger (Pretty (pretty), makeDefaultStderrRecorder, (<+>)) import qualified Ide.Logger as Logger -import Ide.Plugin.Properties ((&)) import Ide.PluginUtils (idePluginsToPluginDesc, pluginDescToIdePlugins) import Ide.Types 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 c08e4344a6..2a44f68091 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -20,7 +20,12 @@ import Language.LSP.Protocol.Types (Range) makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text) makeEditText pm df AddMinimalMethodsParams{..} = do mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup - let ps = makeDeltaAst $ pm_parsed_source pm + let ps = +#if !MIN_VERSION_ghc(9,9,0) + makeDeltaAst $ +#endif + pm_parsed_source pm + old = T.pack $ exactPrint ps (ps', _, _) = runTransform (addMethodDecls ps mDecls range withSig) new = T.pack $ exactPrint ps' @@ -44,8 +49,10 @@ addMethodDecls ps mDecls range withSig go inserting = do allDecls <- hsDecls ps case break (inRange range . getLoc) allDecls of - (before, L l inst : after) -> replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) - (before, []) -> replaceDecls ps before + (before, L l inst : after) -> + replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) + (before, []) -> + replaceDecls ps before -- Add `where` keyword for `instance X where` if `where` is missing. -- @@ -57,33 +64,39 @@ 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) -> + (warnings, anns, key) + | any (\(AddEpAnn kw _ )-> kw == AnnWhere) anns -> instd + | otherwise -> InstD xInstD (ClsInstD ext decl { cid_ext = ( warnings - , AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns - , key) + , AddEpAnn AnnWhere d1 : anns + , key + ) }) #else (EpAnn entry anns comments, key) -> - InstD xInstD (ClsInstD ext decl { - cid_ext = (EpAnn - entry - (AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns) - comments - , key) - }) - _ -> _instd + InstD xInstD (ClsInstD ext decl { + cid_ext = (EpAnn + entry + (AddEpAnn AnnWhere d1 : anns) + comments + , 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 + newLine (L _ e) = + let dp = deltaPos 1 (defaultIndent + 1) {- TODO why is this +1 needed? -} + in L (noAnnSrcSpanDP dp) e #else + newLine (L l e) = + let dp = deltaPos 1 defaultIndent in L (noAnnSrcSpanDP (getLoc l) dp <> l) e #endif - diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index ea4da718ff..1f9b70f2ca 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -63,9 +63,8 @@ codeActionTests = testGroup getActionByTitle "Add placeholders for 'g'" , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $ getActionByTitle "Add placeholders for 'g','h'" - , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $ - goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ - getActionByTitle "Add placeholders for '==' with signature(s)" + ,goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ + getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $ @@ -132,8 +131,7 @@ codeLensTests = testGroup , goldenCodeLens "Apply code lens for local class" "LocalClassDefine" 0 , goldenCodeLens "Apply code lens on the same line" "Inline" 0 , goldenCodeLens "Don't insert pragma while existing" "CodeLensWithPragma" 0 - , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $ - goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0 + , goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0 , goldenCodeLens "Qualified name" "Qualified" 0 , goldenCodeLens "Type family" "TypeFamily" 0 , testCase "keep stale lens" $ do diff --git a/plugins/hls-class-plugin/test/testdata/T5.expected.hs b/plugins/hls-class-plugin/test/testdata/T5.expected.hs index 6c26425f34..fcc51c0787 100644 --- a/plugins/hls-class-plugin/test/testdata/T5.expected.hs +++ b/plugins/hls-class-plugin/test/testdata/T5.expected.hs @@ -1,4 +1,4 @@ -module T1 where +module T5 where data X = X diff --git a/plugins/hls-class-plugin/test/testdata/T5.hs b/plugins/hls-class-plugin/test/testdata/T5.hs index e7dc1d4da3..d33dd8b17c 100644 --- a/plugins/hls-class-plugin/test/testdata/T5.hs +++ b/plugins/hls-class-plugin/test/testdata/T5.hs @@ -1,4 +1,4 @@ -module T1 where +module T5 where data X = X diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index fff2096d44..e910f7606d 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -16,9 +16,9 @@ import Development.IDE.GHC.Compat.ExactPrint import GHC.Parser.Annotation (AddEpAnn (..), DeltaPos (..), EpAnn (..), - EpAnnComments (EpaComments), - spanAsAnchor) + EpAnnComments (EpaComments)) import Ide.PluginUtils (subRange) +import Language.Haskell.GHC.ExactPrint (d1) import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -34,8 +34,8 @@ import GHC.Parser.Annotation (TokenLocation (..)) #if !MIN_VERSION_ghc(9,9,0) import GHC.Parser.Annotation (Anchor (Anchor), AnchorOperation (MovedAnchor), - EpaLocation (EpaDelta), - SrcSpanAnn' (SrcSpanAnn)) + SrcSpanAnn' (SrcSpanAnn), + spanAsAnchor) import Language.Haskell.GHC.ExactPrint (showAst) #endif @@ -227,17 +227,13 @@ 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 + adjustCon (L _ r) = + let delta = EpaDelta (DifferentLine 1 3) [] + in L (EpAnn delta (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)) + let go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2)) + in L (SrcSpanAnn (EpAnn (go (spanAsAnchor loc)) (AnnListItem []) (EpaComments [])) loc) r #endif -- Adjust where annotation to the same line of the type constructor @@ -247,7 +243,7 @@ prettyGADTDecl df decl = #endif (\(AddEpAnn ann l) -> if ann == AnnWhere - then AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) + then AddEpAnn AnnWhere d1 else AddEpAnn ann l ) From bf53e200721a153a797fd756963a4c0337b8b37b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 28 May 2024 16:58:00 +0200 Subject: [PATCH 49/83] Undo spurious changes --- plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 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 2a44f68091..da2faecb07 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -49,10 +49,8 @@ addMethodDecls ps mDecls range withSig go inserting = do allDecls <- hsDecls ps case break (inRange range . getLoc) allDecls of - (before, L l inst : after) -> - replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) - (before, []) -> - replaceDecls ps before + (before, L l inst : after) -> replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) + (before, []) -> replaceDecls ps before -- Add `where` keyword for `instance X where` if `where` is missing. -- From 7530af84419c0abadea085fa97d30d25c5e658b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Wed, 29 May 2024 07:11:01 +0200 Subject: [PATCH 50/83] Update eval plugin tests --- plugins/hls-eval-plugin/test/Main.hs | 21 +++++++++---------- .../TPropertyError.ghc910.expected.hs | 13 ++++++++++++ ...ed.hs => TPropertyError.ghc92.expected.hs} | 0 3 files changed, 23 insertions(+), 11 deletions(-) create mode 100644 plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs rename plugins/hls-eval-plugin/test/testdata/{TPropertyError.expected.hs => TPropertyError.ghc92.expected.hs} (100%) diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index ceb1620bac..48bb239c7d 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -85,7 +85,8 @@ tests = , goldenWithEval "Shows a kind with :kind" "T12" "hs" , goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs" , goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069 - , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98, GHC910] "type +v does not work anymore with 9.2" $ + goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" , goldenWithEval "Doesn't break in module containing main function" "T4139" "hs" , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs" , goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs" @@ -128,16 +129,14 @@ tests = , goldenWithEval "The default language extensions for the eval plugin are the same as those for ghci" "TSameDefaultLanguageExtensionsAsGhci" "hs" , goldenWithEval "IO expressions are supported, stdout/stderr output is ignored" "TIO" "hs" , goldenWithEvalAndFs "Property checking" cabalProjectFS "TProperty" "hs" - , knownBrokenInEnv [HostOS Windows] "The output has path separators in it, which on Windows look different. Just skip it there" $ goldenWithEvalAndFs' "Property checking with exception" cabalProjectFS "TPropertyError" "hs" ( - if ghcVersion >= GHC98 then - "ghc98.expected" - else if ghcVersion >= GHC96 then - "ghc96.expected" - else if ghcVersion >= GHC94 then - "ghc94.expected" - else - "expected" - ) + , knownBrokenInEnv [HostOS Windows] "The output has path separators in it, which on Windows look different. Just skip it there" $ + goldenWithEvalAndFs' "Property checking with exception" cabalProjectFS "TPropertyError" "hs" $ + case ghcVersion of + GHC910 -> "ghc910.expected" + GHC98 -> "ghc98.expected" + GHC96 -> "ghc96.expected" + GHC94 -> "ghc94.expected" + GHC92 -> "ghc92.expected" , goldenWithEval "Prelude has no special treatment, it is imported as stated in the module" "TPrelude" "hs" , goldenWithEval "Don't panic on {-# UNPACK #-} pragma" "TUNPACK" "hs" , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs" diff --git a/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs new file mode 100644 index 0000000000..e3208e37f5 --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc910.expected.hs @@ -0,0 +1,13 @@ +-- Support for property checking +module TProperty where + +-- prop> \(l::[Bool]) -> head l +-- *** Failed! (after 1 test): +-- Exception: +-- Prelude.head: empty list +-- CallStack (from HasCallStack): +-- error, called at libraries/ghc-internal/src/GHC/Internal/List.hs:2030:3 in ghc-internal:GHC.Internal.List +-- errorEmptyList, called at libraries/ghc-internal/src/GHC/Internal/List.hs:96:11 in ghc-internal:GHC.Internal.List +-- badHead, called at libraries/ghc-internal/src/GHC/Internal/List.hs:90:28 in ghc-internal:GHC.Internal.List +-- head, called at :1:27 in interactive:Ghci2 +-- [] diff --git a/plugins/hls-eval-plugin/test/testdata/TPropertyError.expected.hs b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc92.expected.hs similarity index 100% rename from plugins/hls-eval-plugin/test/testdata/TPropertyError.expected.hs rename to plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc92.expected.hs From fca85005a071854c7a4a984f9904d70f764684d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Wed, 29 May 2024 07:11:17 +0200 Subject: [PATCH 51/83] Disable broken refactor plugin test for now --- plugins/hls-refactor-plugin/test/Test/AddArgument.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs index 1816bd2a90..2f741c0003 100644 --- a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs +++ b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs @@ -34,7 +34,9 @@ tests = mkGoldenAddArgTest "AddArgWithSigAndDocs" (r 8 0 8 50), mkGoldenAddArgTest "AddArgFromLet" (r 2 0 2 50), mkGoldenAddArgTest "AddArgFromWhere" (r 3 0 3 50), - mkGoldenAddArgTest "AddArgFromWhereComments" (r 3 0 3 50), + -- TODO can we make this work for GHC 9.10? + knownBrokenForGhcVersions [GHC910] "In GHC 9.10 end-of-line comment annotation is in different place" $ + mkGoldenAddArgTest "AddArgFromWhereComments" (r 3 0 3 50), mkGoldenAddArgTest "AddArgWithTypeSynSig" (r 2 0 2 50), mkGoldenAddArgTest "AddArgWithTypeSynSigContravariant" (r 2 0 2 50), mkGoldenAddArgTest "AddArgWithLambda" (r 1 0 1 50), From aee8cd6edab3e736af116437decbb17d7d23995c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Wed, 29 May 2024 12:58:15 +0200 Subject: [PATCH 52/83] Fix warnings --- ghcide/test/exe/ClientSettingsTests.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/ghcide/test/exe/ClientSettingsTests.hs b/ghcide/test/exe/ClientSettingsTests.hs index 8251558235..7c3c3b27f1 100644 --- a/ghcide/test/exe/ClientSettingsTests.hs +++ b/ghcide/test/exe/ClientSettingsTests.hs @@ -1,8 +1,7 @@ {-# LANGUAGE GADTs #-} module ClientSettingsTests (tests) where -import Config (lspTestCaps, testWithConfig, - testWithDummyPluginEmpty) +import Config (testWithDummyPluginEmpty) import Control.Applicative.Combinators import Control.Monad import Data.Aeson (toJSON) @@ -16,8 +15,7 @@ import Language.LSP.Protocol.Types hiding SemanticTokensEdit (..), mkRange) import Language.LSP.Test -import Test.Hls (testConfigCaps, - waitForProgressDone) +import Test.Hls (waitForProgressDone) import Test.Tasty tests :: TestTree From d25ea1955390218d90da27fb346ff7fa08fd782e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Wed, 29 May 2024 14:21:34 +0200 Subject: [PATCH 53/83] Add source-repository-package to unblock floskell --- cabal.project | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 1326acf257..6ef2d1ea4e 100644 --- a/cabal.project +++ b/cabal.project @@ -49,14 +49,18 @@ if impl(ghc >= 9.9) type:git location: https://github.com/wz1000/retrie.git tag: 2f089092a563b06eccf196751782f1d70000d589 + source-repository-package + type:git + location: https://github.com/jhrcek/floskell.git + tag: dbb5005bf92dbfa5ebd7dba6df1a235d01721782 constraints: lens >= 5.3.2, -- See -- https://github.com/haskell/stylish-haskell/issues/479 -- https://github.com/fourmolu/fourmolu/issues/412 - -- https://github.com/ennocramer/floskell/issues/81 + -- https://github.com/ennocramer/floskell/pull/82 -- https://github.com/ndmitchell/hlint/pull/1594 - haskell-language-server -stylishHaskell -fourmolu -floskell -hlint, + haskell-language-server -stylishHaskell -fourmolu -hlint, allow-newer: entropy:base, entropy:directory, From 28cce3512b7bee21a3774465b1a4a8ab057016f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Wed, 29 May 2024 15:44:05 +0200 Subject: [PATCH 54/83] Make call hierarchy plugin tests green --- plugins/hls-call-hierarchy-plugin/test/Main.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs index 11ac776154..f356a0e278 100644 --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -113,13 +113,14 @@ prepareCallHierarchyTests = , testGroup "data family" [ testCase "1" $ do let contents = T.unlines ["{-# LANGUAGE TypeFamilies #-}", "data family A"] - range = mkRange 1 0 1 11 + -- Since GHC 9.10 the range also includes the family name (and its parameters if any) + range = mkRange 1 0 1 (if ghcVersion == GHC910 then 13 else 11) selRange = mkRange 1 12 1 13 expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected , testCase "2" $ do let contents = T.unlines [ "{-# LANGUAGE TypeFamilies #-}" , "data family A a"] - range = mkRange 1 0 1 11 + range = mkRange 1 0 1 (if ghcVersion == GHC910 then 15 else 11) selRange = mkRange 1 12 1 13 expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected From de0171052b806cf4e7638b7dab8d81c77faecddb Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 29 May 2024 22:50:16 +0800 Subject: [PATCH 55/83] fix semantic tokens 9.10 --- .../test/SemanticTokensTest.hs | 35 ++++++-- .../test/testdata/after_9_10/T1.expected | 82 +++++++++++++++++++ .../test/testdata/{ => after_9_10}/T1.hs | 0 .../test/testdata/after_9_10/TClass.expected | 6 ++ .../test/testdata/{ => after_9_10}/TClass.hs | 0 .../TClassImportedDeriving.expected | 4 + .../TClassImportedDeriving.hs | 0 .../testdata/after_9_10/TDataFamily.expected | 13 +++ .../testdata/{ => after_9_10}/TDataFamily.hs | 0 .../testdata/after_9_10/TDataType.expected | 5 ++ .../testdata/{ => after_9_10}/TDataType.hs | 0 .../after_9_10/TDatatypeImported.expected | 6 ++ .../{ => after_9_10}/TDatatypeImported.hs | 0 .../test/testdata/after_9_10/TDoc.expected | 6 ++ .../test/testdata/{ => after_9_10}/TDoc.hs | 0 .../testdata/after_9_10/TFunction.expected | 12 +++ .../testdata/{ => after_9_10}/TFunction.hs | 0 .../testdata/after_9_10/TFunctionLet.expected | 6 ++ .../testdata/{ => after_9_10}/TFunctionLet.hs | 0 .../after_9_10/TFunctionLocal.expected | 8 ++ .../{ => after_9_10}/TFunctionLocal.hs | 0 .../TFunctionUnderTypeSynonym.expected | 18 ++++ .../TFunctionUnderTypeSynonym.hs | 0 .../test/testdata/after_9_10/TGADT.expected | 14 ++++ .../test/testdata/{ => after_9_10}/TGADT.hs | 0 .../TInstanceClassMethodBind.expected | 8 ++ .../TInstanceClassMethodBind.hs | 0 .../TInstanceClassMethodUse.expected | 3 + .../TInstanceClassMethodUse.hs | 0 .../testdata/{ => after_9_10}/TModuleA.hs | 0 .../testdata/{ => after_9_10}/TModuleB.hs | 0 .../TNoneFunctionWithConstraint.expected | 7 ++ .../TNoneFunctionWithConstraint.hs | 0 .../testdata/after_9_10/TOperator.expected | 34 ++++++++ .../testdata/{ => after_9_10}/TOperator.hs | 0 .../after_9_10/TPatternMatch.expected | 3 + .../{ => after_9_10}/TPatternMatch.hs | 0 .../after_9_10/TPatternSynonym.expected | 2 + .../{ => after_9_10}/TPatternSynonym.hs | 0 .../testdata/after_9_10/TPatternbind.expected | 8 ++ .../testdata/{ => after_9_10}/TPatternbind.hs | 0 .../after_9_10/TQualifiedName.expected | 13 +++ .../{ => after_9_10}/TQualifiedName.hs | 0 .../test/testdata/after_9_10/TRecord.expected | 5 ++ .../test/testdata/{ => after_9_10}/TRecord.hs | 0 .../TRecordDuplicateRecordFields.expected | 5 ++ .../TRecordDuplicateRecordFields.hs | 0 .../testdata/after_9_10/TTypefamily.expected | 9 ++ .../testdata/{ => after_9_10}/TTypefamily.hs | 0 .../after_9_10/TUnicodeSyntax.expected | 2 + .../{ => after_9_10}/TUnicodeSyntax.hs | 0 .../testdata/after_9_10/TValBind.expected | 5 ++ .../testdata/{ => after_9_10}/TValBind.hs | 0 .../testdata/{ => before_9_10}/T1.expected | 0 .../test/testdata/before_9_10/T1.hs | 48 +++++++++++ .../{ => before_9_10}/TClass.expected | 0 .../test/testdata/before_9_10/TClass.hs | 6 ++ .../TClassImportedDeriving.expected | 0 .../before_9_10/TClassImportedDeriving.hs | 10 +++ .../{ => before_9_10}/TDataFamily.expected | 0 .../test/testdata/before_9_10/TDataFamily.hs | 11 +++ .../{ => before_9_10}/TDataType.expected | 0 .../test/testdata/before_9_10/TDataType.hs | 3 + .../TDatatypeImported.expected | 0 .../testdata/before_9_10/TDatatypeImported.hs | 6 ++ .../testdata/{ => before_9_10}/TDoc.expected | 0 .../test/testdata/before_9_10/TDoc.hs | 9 ++ .../{ => before_9_10}/TFunction.expected | 0 .../test/testdata/before_9_10/TFunction.hs | 7 ++ .../{ => before_9_10}/TFunctionLet.expected | 0 .../test/testdata/before_9_10/TFunctionLet.hs | 4 + .../{ => before_9_10}/TFunctionLocal.expected | 0 .../testdata/before_9_10/TFunctionLocal.hs | 8 ++ .../TFunctionUnderTypeSynonym.expected | 0 .../before_9_10/TFunctionUnderTypeSynonym.hs | 9 ++ .../testdata/{ => before_9_10}/TGADT.expected | 0 .../test/testdata/before_9_10/TGADT.hs | 7 ++ .../TInstanceClassMethodBind.expected | 0 .../before_9_10/TInstanceClassMethodBind.hs | 6 ++ .../TInstanceClassMethodUse.expected | 0 .../before_9_10/TInstanceClassMethodUse.hs | 5 ++ .../test/testdata/before_9_10/TModuleA.hs | 5 ++ .../test/testdata/before_9_10/TModuleB.hs | 8 ++ .../TNoneFunctionWithConstraint.expected | 0 .../TNoneFunctionWithConstraint.hs | 5 ++ .../{ => before_9_10}/TOperator.expected | 0 .../test/testdata/before_9_10/TOperator.hs | 13 +++ .../{ => before_9_10}/TPatternMatch.expected | 0 .../testdata/before_9_10/TPatternMatch.hs | 6 ++ .../TPatternSynonym.expected | 0 .../testdata/before_9_10/TPatternSynonym.hs | 7 ++ .../{ => before_9_10}/TPatternbind.expected | 0 .../test/testdata/before_9_10/TPatternbind.hs | 9 ++ .../{ => before_9_10}/TQualifiedName.expected | 0 .../testdata/before_9_10/TQualifiedName.hs | 9 ++ .../{ => before_9_10}/TRecord.expected | 0 .../test/testdata/before_9_10/TRecord.hs | 7 ++ .../TRecordDuplicateRecordFields.expected | 0 .../TRecordDuplicateRecordFields.hs | 5 ++ .../{ => before_9_10}/TTypefamily.expected | 0 .../test/testdata/before_9_10/TTypefamily.hs | 6 ++ .../{ => before_9_10}/TUnicodeSyntax.expected | 0 .../testdata/before_9_10/TUnicodeSyntax.hs | 5 ++ .../{ => before_9_10}/TValBind.expected | 0 .../test/testdata/before_9_10/TValBind.hs | 8 ++ 105 files changed, 545 insertions(+), 6 deletions(-) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/T1.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/T1.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClass.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TClass.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClassImportedDeriving.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TClassImportedDeriving.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataFamily.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TDataFamily.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataType.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TDataType.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDatatypeImported.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TDatatypeImported.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDoc.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TDoc.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunction.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TFunction.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLet.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TFunctionLet.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLocal.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TFunctionLocal.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionUnderTypeSynonym.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TFunctionUnderTypeSynonym.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TGADT.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TGADT.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodBind.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TInstanceClassMethodBind.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodUse.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TInstanceClassMethodUse.hs (100%) rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TModuleA.hs (100%) rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TModuleB.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TNoneFunctionWithConstraint.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TNoneFunctionWithConstraint.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TOperator.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TOperator.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternMatch.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TPatternMatch.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternSynonym.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TPatternSynonym.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternbind.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TPatternbind.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TQualifiedName.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TQualifiedName.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecord.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TRecord.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecordDuplicateRecordFields.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TRecordDuplicateRecordFields.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TTypefamily.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TTypefamily.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TUnicodeSyntax.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TUnicodeSyntax.hs (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TValBind.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => after_9_10}/TValBind.hs (100%) rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/T1.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/T1.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TClass.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClass.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TClassImportedDeriving.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClassImportedDeriving.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TDataFamily.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataFamily.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TDataType.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataType.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TDatatypeImported.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDatatypeImported.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TDoc.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDoc.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TFunction.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunction.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TFunctionLet.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLet.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TFunctionLocal.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLocal.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TFunctionUnderTypeSynonym.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionUnderTypeSynonym.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TGADT.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TGADT.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TInstanceClassMethodBind.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodBind.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TInstanceClassMethodUse.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodUse.hs create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleA.hs create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleB.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TNoneFunctionWithConstraint.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TNoneFunctionWithConstraint.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TOperator.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TOperator.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TPatternMatch.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternMatch.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TPatternSynonym.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternSynonym.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TPatternbind.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternbind.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TQualifiedName.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TQualifiedName.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TRecord.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecord.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TRecordDuplicateRecordFields.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecordDuplicateRecordFields.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TTypefamily.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TTypefamily.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TUnicodeSyntax.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TUnicodeSyntax.hs rename plugins/hls-semantic-tokens-plugin/test/testdata/{ => before_9_10}/TValBind.expected (100%) create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TValBind.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs index 5308b6fd71..ca78715fa5 100644 --- a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs +++ b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs @@ -7,12 +7,14 @@ import Data.Aeson (KeyValue (..), Object) import qualified Data.Aeson.KeyMap as KV import Data.Default import Data.Functor (void) +import qualified Data.List as T import Data.Map.Strict as Map hiding (map) import Data.String (fromString) import Data.Text hiding (length, map, unlines) import qualified Data.Text as Text import qualified Data.Text.Utf16.Rope.Mixed as Rope +import Data.Version (Version (..)) import Development.IDE (Pretty) import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..)) import Ide.Plugin.SemanticTokens @@ -24,12 +26,13 @@ import Language.LSP.Protocol.Types import qualified Language.LSP.Test as Test import Language.LSP.VFS (VirtualFile (..)) import System.FilePath +import System.Info (compilerVersion) import Test.Hls import qualified Test.Hls.FileSystem as FS import Test.Hls.FileSystem (file, text) testDataDir :: FilePath -testDataDir = "plugins" "hls-semantic-tokens-plugin" "test" "testdata" +testDataDir = "plugins" "hls-semantic-tokens-plugin" "test" "testdata" testVersionDir mkFs :: [FS.FileTree] -> FS.VirtualFileTree mkFs = FS.mkVirtualFileTree testDataDir @@ -49,6 +52,14 @@ semanticTokensPlugin = Test.Hls.mkPluginTestDescriptor enabledSemanticDescriptor } } +-- if 9_10 and after we change the directory to the testdata/before_9_10 directory +-- if 9_10 and after we change the directory to the testdata/after_9_10 directory + +testVersionDir :: FilePath +testVersionDir + | compilerVersion >= Version [9, 10] [] = "after_9_10" + | otherwise = "before_9_10" + goldenWithHaskellAndCapsOutPut :: (Pretty b) => Config -> PluginTestDescriptor b -> TestName -> FS.VirtualFileTree -> FilePath -> String -> (TextDocumentIdentifier -> Session String) -> TestTree goldenWithHaskellAndCapsOutPut config plugin title tree path desc act = goldenGitDiff title (FS.vftOriginalRoot tree path <.> desc) $ @@ -151,9 +162,12 @@ semanticTokensConfigTest = doc <- openDoc "Hello.hs" "haskell" void waitForBuildQueue result1 <- docLspSemanticTokensString doc - liftIO $ unlines (map show result1) @?= "2:1-3 SemanticTokenTypes_Variable \"go\"\n" + liftIO $ unlines (map show result1) @?= + T.unlines (["1:8-13 SemanticTokenTypes_Namespace \"Hello\"" | compilerVersion >= Version [9, 10] []] + ++ ["2:1-3 SemanticTokenTypes_Variable \"go\""]) ] + semanticTokensFullDeltaTests :: TestTree semanticTokensFullDeltaTests = testGroup "semanticTokensFullDeltaTests" @@ -168,7 +182,9 @@ semanticTokensFullDeltaTests = liftIO $ delta @?= expectDelta, testCase "add tokens" $ do let file1 = "TModuleA.hs" - let expectDelta = InR (InL (SemanticTokensDelta (Just "1") [SemanticTokensEdit 20 0 (Just [2, 0, 3, 8, 0])])) + let expectDelta + | compilerVersion >= Version [9, 10] [] = InR (InL (SemanticTokensDelta (Just "1") [SemanticTokensEdit 25 0 (Just [2, 0, 3, 8, 0])])) + | otherwise = InR (InL (SemanticTokensDelta (Just "1") [SemanticTokensEdit 20 0 (Just [2, 0, 3, 8, 0])])) -- r c l t m -- where r = row, c = column, l = length, t = token, m = modifier Test.Hls.runSessionWithServerInTmpDir def semanticTokensPlugin (mkFs $ FS.directProjectMulti [file1]) $ do @@ -187,7 +203,9 @@ semanticTokensFullDeltaTests = liftIO $ delta @?= expectDelta, testCase "remove tokens" $ do let file1 = "TModuleA.hs" - let expectDelta = InR (InL (SemanticTokensDelta (Just "1") [SemanticTokensEdit 0 20 (Just [])])) + let expectDelta + | compilerVersion >= Version [9, 10] [] = InR (InL (SemanticTokensDelta (Just "1") [SemanticTokensEdit 5 20 (Just [])])) + | otherwise = InR (InL (SemanticTokensDelta (Just "1") [SemanticTokensEdit 0 20 (Just [])])) -- delete all tokens Test.Hls.runSessionWithServerInTmpDir def semanticTokensPlugin (mkFs $ FS.directProjectMulti [file1]) $ do doc1 <- openDoc file1 "haskell" @@ -226,7 +244,12 @@ semanticTokensTests = result <- docSemanticTokensString def doc2 let expect = unlines - [ "3:8-16 TModule \"TModuleA\"", + ( + -- > 9.10 have module name in the token + (["1:8-16 TModule \"TModuleB\"" | compilerVersion >= Version [9, 10] []]) + ++ + [ + "3:8-16 TModule \"TModuleA\"", "4:18-26 TModule \"TModuleA\"", "6:1-3 TVariable \"go\"", "6:6-10 TDataConstructor \"Game\"", @@ -234,7 +257,7 @@ semanticTokensTests = "8:8-17 TModule \"TModuleA.\"", "8:17-20 TRecordField \"a\\66560b\"", "8:21-23 TVariable \"go\"" - ] + ]) liftIO $ result @?= expect, goldenWithSemanticTokensWithDefaultConfig "mixed constancy test result generated from one ghc version" "T1", goldenWithSemanticTokensWithDefaultConfig "pattern bind" "TPatternSynonym", diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/T1.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/T1.expected new file mode 100644 index 0000000000..eff5c79768 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/T1.expected @@ -0,0 +1,82 @@ +4:8-12 TModule "Main" +9:6-9 TTypeConstructor "Foo" +9:12-15 TDataConstructor "Foo" +9:18-21 TRecordField "foo" +9:25-28 TTypeConstructor "Int" +11:7-10 TClass "Boo" +11:11-12 TTypeVariable "a" +12:3-6 TClassMethod "boo" +12:10-11 TTypeVariable "a" +12:15-16 TTypeVariable "a" +14:10-13 TClass "Boo" +14:14-17 TTypeConstructor "Int" +15:5-8 TClassMethod "boo" +15:9-10 TVariable "x" +15:13-14 TVariable "x" +15:15-16 TOperator "+" +17:6-8 TTypeConstructor "Dd" +17:11-13 TDataConstructor "Dd" +17:14-17 TTypeConstructor "Int" +19:9-12 TPatternSynonym "One" +19:15-18 TDataConstructor "Foo" +21:1-4 TVariable "ggg" +21:7-10 TPatternSynonym "One" +23:6-9 TTypeConstructor "Doo" +23:12-15 TDataConstructor "Doo" +23:16-24 TModule "Prelude." +23:24-27 TTypeConstructor "Int" +24:6-10 TTypeSynonym "Bar1" +24:13-16 TTypeConstructor "Int" +25:6-10 TTypeSynonym "Bar2" +25:13-16 TTypeConstructor "Doo" +27:1-3 TFunction "bb" +27:8-11 TClass "Boo" +27:12-13 TTypeVariable "a" +27:18-19 TTypeVariable "a" +27:23-24 TTypeVariable "a" +28:1-3 TFunction "bb" +28:4-5 TVariable "x" +28:9-12 TClassMethod "boo" +28:13-14 TVariable "x" +29:1-3 TFunction "aa" +29:7-11 TTypeVariable "cool" +29:15-18 TTypeConstructor "Int" +29:22-26 TTypeVariable "cool" +30:1-3 TFunction "aa" +30:4-5 TVariable "x" +30:9-10 TVariable "c" +30:14-16 TFunction "aa" +30:17-18 TVariable "x" +30:19-20 TVariable "c" +31:12-14 TVariable "xx" +31:16-18 TVariable "yy" +32:11-13 TVariable "dd" +34:2-4 TVariable "zz" +34:6-8 TVariable "kk" +35:1-3 TFunction "cc" +35:7-10 TTypeConstructor "Foo" +35:15-18 TTypeConstructor "Int" +35:20-23 TTypeConstructor "Int" +35:28-31 TTypeConstructor "Int" +36:1-3 TFunction "cc" +36:4-5 TVariable "f" +36:7-9 TVariable "gg" +36:11-13 TVariable "vv" +37:10-12 TVariable "gg" +38:14-17 TRecordField "foo" +38:18-19 TOperator "$" +38:20-21 TVariable "f" +38:24-27 TRecordField "foo" +39:14-17 TRecordField "foo" +39:18-19 TOperator "$" +39:20-21 TVariable "f" +39:24-27 TRecordField "foo" +41:1-3 TFunction "go" +41:6-9 TRecordField "foo" +42:1-4 TFunction "add" +42:8-16 TModule "Prelude." +42:16-17 TOperator "+" +47:1-5 TVariable "main" +47:9-11 TTypeConstructor "IO" +48:1-5 TVariable "main" +48:8-16 TFunction "putStrLn" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/T1.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/T1.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/T1.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/T1.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClass.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClass.expected new file mode 100644 index 0000000000..f7bb4cd513 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClass.expected @@ -0,0 +1,6 @@ +1:8-14 TModule "TClass" +4:7-10 TClass "Foo" +4:11-12 TTypeVariable "a" +5:3-6 TClassMethod "foo" +5:10-11 TTypeVariable "a" +5:15-18 TTypeConstructor "Int" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TClass.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClass.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TClass.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClass.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClassImportedDeriving.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClassImportedDeriving.expected new file mode 100644 index 0000000000..9ca97d9082 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClassImportedDeriving.expected @@ -0,0 +1,4 @@ +2:8-30 TModule "TClassImportedDeriving" +4:6-9 TTypeConstructor "Foo" +4:12-15 TDataConstructor "Foo" +4:26-30 TClass "Show" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClassImportedDeriving.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TClassImportedDeriving.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataFamily.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataFamily.expected new file mode 100644 index 0000000000..b3b477e541 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataFamily.expected @@ -0,0 +1,13 @@ +2:8-19 TModule "TDatafamily" +5:13-18 TTypeFamily "XList" +5:19-20 TTypeVariable "a" +8:15-20 TTypeFamily "XList" +8:21-25 TTypeConstructor "Char" +8:28-33 TDataConstructor "XCons" +8:35-39 TTypeConstructor "Char" +8:42-47 TTypeFamily "XList" +8:48-52 TTypeConstructor "Char" +8:56-60 TDataConstructor "XNil" +11:15-20 TTypeFamily "XList" +11:26-35 TDataConstructor "XListUnit" +11:37-40 TTypeConstructor "Int" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataFamily.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataFamily.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataType.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataType.expected new file mode 100644 index 0000000000..7f03f4ed54 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataType.expected @@ -0,0 +1,5 @@ +1:8-17 TModule "TDataType" +3:6-9 TTypeConstructor "Foo" +3:12-15 TDataConstructor "Foo" +3:16-19 TTypeConstructor "Int" +3:30-32 TClass "Eq" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataType.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDataType.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDatatypeImported.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDatatypeImported.expected new file mode 100644 index 0000000000..78ebf2bc22 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDatatypeImported.expected @@ -0,0 +1,6 @@ +1:8-25 TModule "TDatatypeImported" +3:8-17 TModule "System.IO" +5:1-3 TVariable "go" +5:7-9 TTypeConstructor "IO" +6:1-3 TVariable "go" +6:6-11 TFunction "print" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDatatypeImported.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDatatypeImported.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDoc.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDoc.expected new file mode 100644 index 0000000000..30b1cdb345 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDoc.expected @@ -0,0 +1,6 @@ +1:8-12 TModule "TDoc" +4:5-10 TVariable "hello" +5:1-6 TVariable "hello" +5:10-13 TTypeConstructor "Int" +6:1-6 TVariable "hello" +6:9-15 TClassMethod "length" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDoc.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDoc.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDoc.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TDoc.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunction.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunction.expected new file mode 100644 index 0000000000..2b715e0a40 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunction.expected @@ -0,0 +1,12 @@ +1:8-17 TModule "TFunction" +3:1-2 TFunction "f" +3:13-14 TTypeVariable "a" +3:16-17 TTypeVariable "a" +3:21-22 TTypeVariable "a" +4:1-2 TFunction "f" +4:3-4 TVariable "x" +4:7-8 TVariable "x" +6:1-2 TVariable "x" +6:6-7 TTypeVariable "a" +7:1-2 TVariable "x" +7:5-14 TVariable "undefined" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunction.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunction.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunction.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunction.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLet.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLet.expected new file mode 100644 index 0000000000..f51938a712 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLet.expected @@ -0,0 +1,6 @@ +1:8-20 TModule "TFunctionLet" +3:1-2 TVariable "y" +3:6-9 TTypeConstructor "Int" +4:1-2 TVariable "y" +4:9-10 TFunction "f" +4:11-12 TVariable "x" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLet.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLet.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLocal.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLocal.expected new file mode 100644 index 0000000000..34e040d641 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLocal.expected @@ -0,0 +1,8 @@ +1:8-22 TModule "TFunctionLocal" +3:1-2 TFunction "f" +3:6-9 TTypeConstructor "Int" +3:13-16 TTypeConstructor "Int" +4:1-2 TFunction "f" +4:7-8 TFunction "g" +6:5-6 TFunction "g" +6:7-8 TVariable "x" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLocal.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionLocal.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionUnderTypeSynonym.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionUnderTypeSynonym.expected new file mode 100644 index 0000000000..0779402a83 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionUnderTypeSynonym.expected @@ -0,0 +1,18 @@ +1:8-33 TModule "TFunctionUnderTypeSynonym" +3:6-8 TTypeSynonym "T1" +3:11-14 TTypeConstructor "Int" +3:18-21 TTypeConstructor "Int" +4:6-8 TTypeSynonym "T2" +4:18-19 TTypeVariable "a" +4:21-22 TTypeVariable "a" +4:26-27 TTypeVariable "a" +5:1-3 TFunction "f1" +5:7-9 TTypeSynonym "T1" +6:1-3 TFunction "f1" +6:4-5 TVariable "x" +6:8-9 TVariable "x" +7:1-3 TFunction "f2" +7:7-9 TTypeSynonym "T2" +8:1-3 TFunction "f2" +8:4-5 TVariable "x" +8:8-9 TVariable "x" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionUnderTypeSynonym.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionUnderTypeSynonym.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionUnderTypeSynonym.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TFunctionUnderTypeSynonym.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TGADT.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TGADT.expected new file mode 100644 index 0000000000..3f07298543 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TGADT.expected @@ -0,0 +1,14 @@ +3:8-13 TModule "TGADT" +5:6-9 TTypeConstructor "Lam" +6:3-7 TDataConstructor "Lift" +6:11-12 TTypeVariable "a" +6:36-39 TTypeConstructor "Lam" +6:40-41 TTypeVariable "a" +7:3-6 TDataConstructor "Lam" +7:12-15 TTypeConstructor "Lam" +7:16-17 TTypeVariable "a" +7:21-24 TTypeConstructor "Lam" +7:25-26 TTypeVariable "b" +7:36-39 TTypeConstructor "Lam" +7:41-42 TTypeVariable "a" +7:46-47 TTypeVariable "b" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TGADT.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TGADT.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodBind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodBind.expected new file mode 100644 index 0000000000..b93e340ac3 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodBind.expected @@ -0,0 +1,8 @@ +1:8-32 TModule "TInstanceClassMethodBind" +4:6-9 TTypeConstructor "Foo" +4:12-15 TDataConstructor "Foo" +4:16-19 TTypeConstructor "Int" +5:10-14 TClass "Show" +5:15-18 TTypeConstructor "Foo" +6:5-9 TClassMethod "show" +6:12-21 TVariable "undefined" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodBind.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodBind.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodUse.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodUse.expected new file mode 100644 index 0000000000..3fc60caab3 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodUse.expected @@ -0,0 +1,3 @@ +1:8-31 TModule "TInstanceClassMethodUse" +4:1-3 TFunction "go" +4:8-12 TClassMethod "show" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodUse.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodUse.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodUse.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TInstanceClassMethodUse.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TModuleA.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TModuleA.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TModuleA.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TModuleA.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TModuleB.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TModuleB.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TModuleB.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TModuleB.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TNoneFunctionWithConstraint.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TNoneFunctionWithConstraint.expected new file mode 100644 index 0000000000..a004142952 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TNoneFunctionWithConstraint.expected @@ -0,0 +1,7 @@ +1:8-35 TModule "TNoneFunctionWithConstraint" +3:1-2 TVariable "x" +3:7-9 TClass "Eq" +3:10-11 TTypeVariable "a" +3:16-17 TTypeVariable "a" +4:1-2 TVariable "x" +4:5-14 TVariable "undefined" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TNoneFunctionWithConstraint.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TNoneFunctionWithConstraint.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TNoneFunctionWithConstraint.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TNoneFunctionWithConstraint.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TOperator.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TOperator.expected new file mode 100644 index 0000000000..c8b2ecb29d --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TOperator.expected @@ -0,0 +1,34 @@ +1:8-17 TModule "TOperator" +4:1-3 TFunction "go" +4:4-5 TFunction "f" +4:6-7 TVariable "x" +4:10-11 TFunction "f" +4:11-12 TOperator "$" +4:12-13 TVariable "x" +6:2-6 TOperator "$$$$" +7:1-2 TVariable "x" +7:7-11 TOperator "$$$$" +8:6-7 TTypeVariable "a" +8:8-11 TOperator ":+:" +8:12-13 TTypeVariable "b" +8:16-19 TDataConstructor "Add" +8:20-21 TTypeVariable "a" +8:22-23 TTypeVariable "b" +9:7-10 TOperator ":-:" +9:12-13 TTypeVariable "a" +9:14-15 TTypeVariable "b" +9:19-20 TTypeVariable "a" +9:22-23 TTypeVariable "b" +11:1-4 TFunction "add" +11:8-11 TTypeConstructor "Int" +11:12-15 TOperator ":+:" +11:16-19 TTypeConstructor "Int" +11:23-26 TTypeConstructor "Int" +11:27-30 TOperator ":-:" +11:31-34 TTypeConstructor "Int" +13:1-4 TFunction "add" +13:6-9 TDataConstructor "Add" +13:10-11 TVariable "x" +13:12-13 TVariable "y" +13:18-19 TVariable "x" +13:21-22 TVariable "y" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TOperator.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TOperator.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternMatch.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternMatch.expected new file mode 100644 index 0000000000..b17e52e27f --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternMatch.expected @@ -0,0 +1,3 @@ +1:8-21 TModule "TPatternMatch" +4:1-2 TFunction "g" +4:4-11 TDataConstructor "Nothing" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternMatch.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternMatch.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternSynonym.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternSynonym.expected new file mode 100644 index 0000000000..b9cff7321a --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternSynonym.expected @@ -0,0 +1,2 @@ +2:8-23 TModule "TPatternSynonym" +5:9-12 TPatternSynonym "Foo" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternSynonym.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternSynonym.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternbind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternbind.expected new file mode 100644 index 0000000000..ab12539d12 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternbind.expected @@ -0,0 +1,8 @@ +1:8-17 TModule "TVariable" +3:2-3 TVariable "a" +3:5-6 TVariable "b" +5:1-2 TFunction "f" +5:3-4 TFunction "g" +5:5-6 TVariable "y" +5:9-10 TFunction "g" +5:11-12 TVariable "y" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternbind.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternbind.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternbind.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TPatternbind.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TQualifiedName.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TQualifiedName.expected new file mode 100644 index 0000000000..df305195ed --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TQualifiedName.expected @@ -0,0 +1,13 @@ +1:8-22 TModule "TQualifiedName" +3:18-27 TModule "Data.List" +6:1-2 TVariable "a" +6:5-13 TModule "Prelude." +6:13-22 TVariable "undefined" +7:1-2 TVariable "b" +7:8-18 TModule "Data.List." +7:18-22 TClassMethod "elem" +8:1-2 TVariable "c" +8:6-14 TModule "Prelude." +8:14-15 TOperator "+" +9:1-2 TVariable "d" +9:6-7 TOperator "+" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TQualifiedName.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TQualifiedName.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TQualifiedName.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TQualifiedName.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecord.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecord.expected new file mode 100644 index 0000000000..5be40a4a39 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecord.expected @@ -0,0 +1,5 @@ +1:8-15 TModule "TRecord" +4:6-9 TTypeConstructor "Foo" +4:12-15 TDataConstructor "Foo" +4:18-21 TRecordField "foo" +4:25-28 TTypeConstructor "Int" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecord.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecord.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecordDuplicateRecordFields.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecordDuplicateRecordFields.expected new file mode 100644 index 0000000000..04ef050ab0 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecordDuplicateRecordFields.expected @@ -0,0 +1,5 @@ +3:8-36 TModule "TRecordDuplicateRecordFields" +5:6-9 TTypeConstructor "Foo" +5:12-15 TDataConstructor "Foo" +5:18-21 TRecordField "boo" +5:26-32 TTypeSynonym "String" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecordDuplicateRecordFields.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TRecordDuplicateRecordFields.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TTypefamily.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TTypefamily.expected new file mode 100644 index 0000000000..1aa6bf4687 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TTypefamily.expected @@ -0,0 +1,9 @@ +2:8-19 TModule "TTypefamily" +4:13-16 TTypeFamily "Foo" +4:17-18 TTypeVariable "a" +5:3-6 TTypeFamily "Foo" +5:7-10 TTypeConstructor "Int" +5:13-16 TTypeConstructor "Int" +6:3-6 TTypeFamily "Foo" +6:7-8 TTypeVariable "a" +6:11-17 TTypeSynonym "String" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TTypefamily.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TTypefamily.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TUnicodeSyntax.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TUnicodeSyntax.expected new file mode 100644 index 0000000000..ad9f6ea762 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TUnicodeSyntax.expected @@ -0,0 +1,2 @@ +1:8-22 TModule "TUnicodeSyntax" +3:1-4 TVariable "a\66560b" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TUnicodeSyntax.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TUnicodeSyntax.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TUnicodeSyntax.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TUnicodeSyntax.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TValBind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TValBind.expected new file mode 100644 index 0000000000..700509c968 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TValBind.expected @@ -0,0 +1,5 @@ +1:8-16 TModule "TValBind" +4:1-6 TVariable "hello" +4:10-13 TTypeConstructor "Int" +5:1-6 TVariable "hello" +5:9-15 TClassMethod "length" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TValBind.hs similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/after_9_10/TValBind.hs diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/T1.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/T1.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/T1.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/T1.hs new file mode 100644 index 0000000000..07b0476c1e --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/T1.hs @@ -0,0 +1,48 @@ +-- patter syn +{-# LANGUAGE PatternSynonyms #-} + +module Main where + +-- import Data.Set (Set, insert) + + +data Foo = Foo { foo :: Int } + +class Boo a where + boo :: a -> a + +instance Boo Int where + boo x = x + 1 + +data Dd = Dd Int + +pattern One = Foo 1 + +ggg = One + +data Doo = Doo Prelude.Int +type Bar1 = Int +type Bar2 = Doo + +bb :: (Boo a) => a -> a +bb x = boo x +aa :: cool -> Int -> cool +aa x = \c -> aa x c + where (xx, yy) = (1, 2) + dd = 1 + +(zz, kk) = (1, 2) +cc :: Foo -> (Int, Int) -> Int +cc f (gg, vv)= + case gg of + 1 -> foo $ f { foo = 1 } + 2 -> foo $ f { foo = 1 } + +go = foo +add = (Prelude.+) + +-- sub :: Int -> Int -> Int +-- sub x y = add x y + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TClass.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClass.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TClass.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClass.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClass.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClass.hs new file mode 100644 index 0000000000..692754ec71 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClass.hs @@ -0,0 +1,6 @@ +module TClass where + + +class Foo a where + foo :: a -> Int + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClassImportedDeriving.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClassImportedDeriving.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClassImportedDeriving.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClassImportedDeriving.hs new file mode 100644 index 0000000000..8afd8afbd9 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TClassImportedDeriving.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE StandaloneDeriving #-} +module TClassImportedDeriving where +-- deriving method source span of Show occurrence +data Foo = Foo deriving (Show) + +-- standalone deriving method not in the same position +-- deriving instance Eq Foo + +-- a :: Foo -> Foo -> Bool +-- a = (==) diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataFamily.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataFamily.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataFamily.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataFamily.hs new file mode 100644 index 0000000000..b9047a72d2 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataFamily.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} +module TDatafamily where + +-- Declare a list-like data family +data family XList a + +-- Declare a list-like instance for Char +data instance XList Char = XCons !Char !(XList Char) | XNil + +-- Declare a number-like instance for () +data instance XList () = XListUnit !Int diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataType.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataType.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataType.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataType.hs new file mode 100644 index 0000000000..894065e391 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDataType.hs @@ -0,0 +1,3 @@ +module TDataType where + +data Foo = Foo Int deriving (Eq) diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDatatypeImported.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDatatypeImported.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDatatypeImported.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDatatypeImported.hs new file mode 100644 index 0000000000..f6ac8996d9 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDatatypeImported.hs @@ -0,0 +1,6 @@ +module TDatatypeImported where + +import System.IO + +go :: IO () +go = print 1 diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDoc.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDoc.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TDoc.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDoc.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDoc.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDoc.hs new file mode 100644 index 0000000000..dc5801b0e6 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TDoc.hs @@ -0,0 +1,9 @@ +module TDoc where + +-- | +-- `hello` +hello :: Int +hello = length "Hello, Haskell!" + + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunction.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunction.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunction.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunction.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunction.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunction.hs new file mode 100644 index 0000000000..4efe5cecc4 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunction.hs @@ -0,0 +1,7 @@ +module TFunction where + +f :: forall a. a -> a +f x = x + +x :: a +x = undefined diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLet.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLet.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLet.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLet.hs new file mode 100644 index 0000000000..96854c34ad --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLet.hs @@ -0,0 +1,4 @@ +module TFunctionLet where + +y :: Int +y = let f x = 1 in 1 diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLocal.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLocal.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLocal.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLocal.hs new file mode 100644 index 0000000000..fed144b00c --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionLocal.hs @@ -0,0 +1,8 @@ +module TFunctionLocal where + +f :: Int -> Int +f 1 = g 1 + where + g x = 1 + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionUnderTypeSynonym.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionUnderTypeSynonym.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionUnderTypeSynonym.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionUnderTypeSynonym.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionUnderTypeSynonym.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionUnderTypeSynonym.hs new file mode 100644 index 0000000000..6485232394 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TFunctionUnderTypeSynonym.hs @@ -0,0 +1,9 @@ +module TFunctionUnderTypeSynonym where + +type T1 = Int -> Int +type T2 = forall a. a -> a +f1 :: T1 +f1 x = x +f2 :: T2 +f2 x = x + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TGADT.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TGADT.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TGADT.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TGADT.hs new file mode 100644 index 0000000000..e0cccf8bed --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TGADT.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} +module TGADT where + +data Lam :: * -> * where + Lift :: a -> Lam a -- ^ lifted value + Lam :: (Lam a -> Lam b) -> Lam (a -> b) -- ^ lambda abstraction diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodBind.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodBind.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodBind.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodBind.hs new file mode 100644 index 0000000000..33976a48c1 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodBind.hs @@ -0,0 +1,6 @@ +module TInstanceClassMethodBind where + + +data Foo = Foo Int +instance Show Foo where + show = undefined diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodUse.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodUse.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodUse.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodUse.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodUse.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodUse.hs new file mode 100644 index 0000000000..689d1643d4 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TInstanceClassMethodUse.hs @@ -0,0 +1,5 @@ +module TInstanceClassMethodUse where + + +go = show + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleA.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleA.hs new file mode 100644 index 0000000000..d76f64fc1f --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleA.hs @@ -0,0 +1,5 @@ +module TModuleA where + +data Game = Game {a𐐀b :: Int} + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleB.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleB.hs new file mode 100644 index 0000000000..d2bfe4b7fa --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TModuleB.hs @@ -0,0 +1,8 @@ +module TModuleB where + +import TModuleA +import qualified TModuleA + +go = Game 1 + +a𐐀bb = TModuleA.a𐐀b go diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TNoneFunctionWithConstraint.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TNoneFunctionWithConstraint.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TNoneFunctionWithConstraint.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TNoneFunctionWithConstraint.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TNoneFunctionWithConstraint.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TNoneFunctionWithConstraint.hs new file mode 100644 index 0000000000..9a7119dbdb --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TNoneFunctionWithConstraint.hs @@ -0,0 +1,5 @@ +module TNoneFunctionWithConstraint where + +x :: (Eq a) => a +x = undefined + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TOperator.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TOperator.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TOperator.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TOperator.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TOperator.hs new file mode 100644 index 0000000000..e2f06c92fa --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TOperator.hs @@ -0,0 +1,13 @@ +module TOperator where + +-- imported operator +go f x = f$x +-- operator defined in local module +($$$$) = b +x = 1 $$$$ 2 +data a :+: b = Add a b +type (:-:) a b = (a, b) +-- type take precedence over operator +add :: Int :+: Int -> Int :-: Int +-- class method take precedence over operator +add (Add x y) = (x, y) diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternMatch.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternMatch.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternMatch.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternMatch.hs new file mode 100644 index 0000000000..95e97c1abb --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternMatch.hs @@ -0,0 +1,6 @@ +module TPatternMatch where + + +g (Nothing, _) = 1 + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternSynonym.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternSynonym.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternSynonym.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternSynonym.hs new file mode 100644 index 0000000000..adff673ce8 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternSynonym.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module TPatternSynonym where + + +pattern Foo = 1 + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternbind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternbind.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternbind.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternbind.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternbind.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternbind.hs new file mode 100644 index 0000000000..49e642a35d --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TPatternbind.hs @@ -0,0 +1,9 @@ +module TVariable where + +(a, b) = (1, 2) + +f g y = g y + + + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TQualifiedName.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TQualifiedName.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TQualifiedName.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TQualifiedName.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TQualifiedName.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TQualifiedName.hs new file mode 100644 index 0000000000..5dbdcc1d52 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TQualifiedName.hs @@ -0,0 +1,9 @@ +module TQualifiedName where + +import qualified Data.List + + +a = Prelude.undefined +b = 1 `Data.List.elem` [1, 2] +c = (Prelude.+) 1 1 +d = (+) 1 1 diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecord.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecord.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecord.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecord.hs new file mode 100644 index 0000000000..b3176a154f --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecord.hs @@ -0,0 +1,7 @@ +module TRecord where + + +data Foo = Foo { foo :: Int } + + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecordDuplicateRecordFields.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecordDuplicateRecordFields.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecordDuplicateRecordFields.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecordDuplicateRecordFields.hs new file mode 100644 index 0000000000..395a1d3731 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TRecordDuplicateRecordFields.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module TRecordDuplicateRecordFields where + +data Foo = Foo { boo :: !String } diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TTypefamily.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TTypefamily.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TTypefamily.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TTypefamily.hs new file mode 100644 index 0000000000..d8c925e370 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TTypefamily.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} +module TTypefamily where + +type family Foo a where + Foo Int = Int + Foo a = String diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TUnicodeSyntax.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TUnicodeSyntax.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TUnicodeSyntax.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TUnicodeSyntax.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TUnicodeSyntax.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TUnicodeSyntax.hs new file mode 100644 index 0000000000..1b8c7c1baa --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TUnicodeSyntax.hs @@ -0,0 +1,5 @@ +module TUnicodeSyntax where + +a𐐀b = "a𐐀b" + + diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TValBind.expected similarity index 100% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.expected rename to plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TValBind.expected diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TValBind.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TValBind.hs new file mode 100644 index 0000000000..506af37a42 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/before_9_10/TValBind.hs @@ -0,0 +1,8 @@ +module TValBind where + + +hello :: Int +hello = length "Hello, Haskell!" + + + From 07087f25036803d4b7e72a4d46bf2a0d8bbd6536 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 30 May 2024 11:41:54 +0200 Subject: [PATCH 56/83] Fix remaining class plugin test --- .../src/Ide/Plugin/Class/ExactPrint.hs | 25 +++++++++++++------ 1 file changed, 18 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 da2faecb07..b1ad346b0f 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -5,18 +5,21 @@ module Ide.Plugin.Class.ExactPrint where import Control.Monad.Trans.Maybe +import Data.Either.Extra (eitherToMaybe) +import Data.Functor.Identity (Identity) import qualified Data.Text as T import Development.IDE.GHC.Compat +import GHC.Parser.Annotation import Ide.Plugin.Class.Types import Ide.Plugin.Class.Utils import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers - -import Data.Either.Extra (eitherToMaybe) -import Data.Functor.Identity (Identity) -import GHC.Parser.Annotation import Language.LSP.Protocol.Types (Range) +#if MIN_VERSION_ghc(9,9,0) +import Control.Lens (_head, over) +#endif + makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text) makeEditText pm df AddMinimalMethodsParams{..} = do mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup @@ -49,8 +52,16 @@ addMethodDecls ps mDecls range withSig go inserting = do allDecls <- hsDecls ps case break (inRange range . getLoc) allDecls of - (before, L l inst : after) -> replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) - (before, []) -> replaceDecls ps before + (before, L l inst : after) -> + let resetFollowing = +#if MIN_VERSION_ghc(9,9,0) + over _head (\followingDecl -> setEntryDP followingDecl (DifferentLine 2 0)) +#else + id +#endif + in replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ resetFollowing after)) + (before, []) -> + replaceDecls ps before -- Add `where` keyword for `instance X where` if `where` is missing. -- @@ -91,7 +102,7 @@ addMethodDecls ps mDecls range withSig #if MIN_VERSION_ghc(9,9,0) newLine (L _ e) = - let dp = deltaPos 1 (defaultIndent + 1) {- TODO why is this +1 needed? -} + let dp = deltaPos 1 (defaultIndent + 1) -- +1 necessary after harmonization of exactprint deltas in ghc 9.10 in L (noAnnSrcSpanDP dp) e #else newLine (L l e) = From 58aa7142da3c93078c0116dd82f7a18604f8a13a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 30 May 2024 16:45:23 +0200 Subject: [PATCH 57/83] Update hls-change-type tests --- plugins/hls-change-type-signature-plugin/test/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index da7e789b61..d34e19ea4f 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -39,7 +39,8 @@ test :: TestTree test = testGroup "changeTypeSignature" [ testRegexes , codeActionTest "TExpectedActual" 4 11 - , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "Error Message in 9.2/9.4 does not provide enough info" $ codeActionTest "TRigidType" 4 14 + , knownBrokenForGhcVersions [GHC92 .. GHC910] "Error Message in 9.2+ does not provide enough info" $ + codeActionTest "TRigidType" 4 14 , codeActionTest "TRigidType2" 4 6 , codeActionTest "TLocalBinding" 7 22 , codeActionTest "TLocalBindingShadow1" 11 8 From ec02b1143bfb6448aa4c12e3e4df3683026a7328 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 31 May 2024 19:21:39 +0200 Subject: [PATCH 58/83] Make class plugin more robust --- .../src/Ide/Plugin/Class/ExactPrint.hs | 34 +++++++++++-------- plugins/hls-class-plugin/test/Main.hs | 2 ++ .../test/testdata/T7.expected.hs | 20 +++++++++++ plugins/hls-class-plugin/test/testdata/T7.hs | 17 ++++++++++ 4 files changed, 59 insertions(+), 14 deletions(-) create mode 100644 plugins/hls-class-plugin/test/testdata/T7.expected.hs create mode 100644 plugins/hls-class-plugin/test/testdata/T7.hs 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 b1ad346b0f..db8aa349df 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -53,11 +53,28 @@ addMethodDecls ps mDecls range withSig allDecls <- hsDecls ps case break (inRange range . getLoc) allDecls of (before, L l inst : after) -> - let resetFollowing = #if MIN_VERSION_ghc(9,9,0) - over _head (\followingDecl -> setEntryDP followingDecl (DifferentLine 2 0)) + let instSpan = realSrcSpan $ locA l + instRow = srcSpanEndLine instSpan + instCol = srcSpanStartCol instSpan + methodEpAnn = noAnnSrcSpanDP $ deltaPos 1 (instCol + defaultIndent) + -- Put each TyCl method/type signature on separate line, indented by 2 spaces relative to instance decl + newLine (L _ e) = L methodEpAnn e + + -- Set DeltaPos for following declarations so they don't move undesirably + resetFollowing = + over _head (\followingDecl -> + let followingDeclRow = srcSpanStartLine $ realSrcSpan $ locA followingDecl + delta = DifferentLine (followingDeclRow - instRow) instCol + in setEntryDP followingDecl delta) #else - id + let instSpan = realSrcSpan $ getLoc l + instCol = srcSpanStartCol instSpan + newLine (L l e) = + let dp = deltaPos 1 (instCol + defaultIndent - 1) + in L (noAnnSrcSpanDP (getLoc l) dp <> l) e + + resetFollowing = id #endif in replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ resetFollowing after)) (before, []) -> @@ -98,14 +115,3 @@ addMethodDecls ps mDecls range withSig _ -> instd #endif addWhere decl = decl - - -#if MIN_VERSION_ghc(9,9,0) - newLine (L _ e) = - let dp = deltaPos 1 (defaultIndent + 1) -- +1 necessary after harmonization of exactprint deltas in ghc 9.10 - in L (noAnnSrcSpanDP dp) e -#else - newLine (L l e) = - let dp = deltaPos 1 defaultIndent - in L (noAnnSrcSpanDP (getLoc l) dp <> l) e -#endif diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index 1f9b70f2ca..4a332e6693 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -63,6 +63,8 @@ codeActionTests = testGroup getActionByTitle "Add placeholders for 'g'" , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $ getActionByTitle "Add placeholders for 'g','h'" + , goldenWithClass "Creates a placeholder when all top-level decls are indented" "T7" "" $ + getActionByTitle "Add placeholders for 'g','h','i'" ,goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ diff --git a/plugins/hls-class-plugin/test/testdata/T7.expected.hs b/plugins/hls-class-plugin/test/testdata/T7.expected.hs new file mode 100644 index 0000000000..5bf716c900 --- /dev/null +++ b/plugins/hls-class-plugin/test/testdata/T7.expected.hs @@ -0,0 +1,20 @@ +module T7 where + + data X = X + + class Test a where + f :: a -> a + g :: a + h :: a -> a + i :: a + + instance Test X where + f X = X + g = _ + h = _ + i = _ + + + + + whiteSpaceBeforeAndIndentationOfThisShouldBePreserved = () diff --git a/plugins/hls-class-plugin/test/testdata/T7.hs b/plugins/hls-class-plugin/test/testdata/T7.hs new file mode 100644 index 0000000000..2f9a1b67f6 --- /dev/null +++ b/plugins/hls-class-plugin/test/testdata/T7.hs @@ -0,0 +1,17 @@ +module T7 where + + data X = X + + class Test a where + f :: a -> a + g :: a + h :: a -> a + i :: a + + instance Test X where + f X = X + + + + + whiteSpaceBeforeAndIndentationOfThisShouldBePreserved = () From 3283c6b2dfd53bd2ae3563f214b11c43f82de45e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 1 Jun 2024 08:02:38 +0200 Subject: [PATCH 59/83] Fix stylish parse errors, simplify CPP --- .../src/Ide/Plugin/Class/ExactPrint.hs | 9 ++++----- plugins/hls-eval-plugin/test/Main.hs | 11 +++++------ .../src/Development/IDE/Plugin/CodeAction.hs | 16 +++++++++------- 3 files changed, 18 insertions(+), 18 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 db8aa349df..11afcfd1c4 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -53,10 +53,11 @@ addMethodDecls ps mDecls range withSig allDecls <- hsDecls ps case break (inRange range . getLoc) allDecls of (before, L l inst : after) -> + let + instSpan = realSrcSpan $ getLoc l + instCol = srcSpanStartCol instSpan #if MIN_VERSION_ghc(9,9,0) - let instSpan = realSrcSpan $ locA l instRow = srcSpanEndLine instSpan - instCol = srcSpanStartCol instSpan methodEpAnn = noAnnSrcSpanDP $ deltaPos 1 (instCol + defaultIndent) -- Put each TyCl method/type signature on separate line, indented by 2 spaces relative to instance decl newLine (L _ e) = L methodEpAnn e @@ -64,12 +65,10 @@ addMethodDecls ps mDecls range withSig -- Set DeltaPos for following declarations so they don't move undesirably resetFollowing = over _head (\followingDecl -> - let followingDeclRow = srcSpanStartLine $ realSrcSpan $ locA followingDecl + let followingDeclRow = srcSpanStartLine $ realSrcSpan $ getLoc followingDecl delta = DifferentLine (followingDeclRow - instRow) instCol in setEntryDP followingDecl delta) #else - let instSpan = realSrcSpan $ getLoc l - instCol = srcSpanStartCol instSpan newLine (L l e) = let dp = deltaPos 1 (instCol + defaultIndent - 1) in L (noAnnSrcSpanDP (getLoc l) dp <> l) e diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 48bb239c7d..b88866b839 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -85,7 +84,7 @@ tests = , goldenWithEval "Shows a kind with :kind" "T12" "hs" , goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs" , goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069 - , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98, GHC910] "type +v does not work anymore with 9.2" $ + , knownBrokenForGhcVersions [GHC92 .. ] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" , goldenWithEval "Doesn't break in module containing main function" "T4139" "hs" , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs" @@ -133,10 +132,10 @@ tests = goldenWithEvalAndFs' "Property checking with exception" cabalProjectFS "TPropertyError" "hs" $ case ghcVersion of GHC910 -> "ghc910.expected" - GHC98 -> "ghc98.expected" - GHC96 -> "ghc96.expected" - GHC94 -> "ghc94.expected" - GHC92 -> "ghc92.expected" + GHC98 -> "ghc98.expected" + GHC96 -> "ghc96.expected" + GHC94 -> "ghc94.expected" + GHC92 -> "ghc92.expected" , goldenWithEval "Prelude has no special treatment, it is imported as stated in the module" "TPrelude" "hs" , goldenWithEval "Don't panic on {-# UNPACK #-} pragma" "TUNPACK" "hs" , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs" 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 03799b7765..5a7c1b21d8 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1232,15 +1232,17 @@ suggestAddRecordFieldImport exportsMap df ps fileContents Diagnostic {..} -- | Suggests a constraint for a declaration for which a constraint is missing. suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] +suggestConstraint df ps diag@Diagnostic {..} + | Just missingConstraint <- findMissingConstraint _message + = let #if MIN_VERSION_ghc(9,9,0) -suggestConstraint df parsedModule diag@Diagnostic {..} + parsedSource = ps #else -suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} + parsedSource = makeDeltaAst ps #endif - | Just missingConstraint <- findMissingConstraint _message - = let codeAction = if _message =~ ("the type signature for:" :: String) - then suggestFunctionConstraint df parsedModule - else suggestInstanceConstraint df parsedModule + codeAction = if _message =~ ("the type signature for:" :: String) + then suggestFunctionConstraint df parsedSource + else suggestInstanceConstraint df parsedSource in codeAction diag missingConstraint | otherwise = [] where @@ -1984,7 +1986,7 @@ smallerRangesForBindingExport lies b = concatMap (mapMaybe srcSpanToRange . ranges') lies where unqualify = snd . breakOnEnd "." - b' = wrapOperatorInParens . unqualify $ b + b' = wrapOperatorInParens $ unqualify b #if MIN_VERSION_ghc(9,9,0) ranges' (L _ (IEThingWith _ thing _ inners _)) #else From 750ee5b45d0ca5af51e2c558e9022bb3cbc31997 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 1 Jun 2024 14:41:55 +0200 Subject: [PATCH 60/83] Cleanups --- ghcide/test/exe/FindDefinitionAndHoverTests.hs | 2 +- plugins/hls-class-plugin/test/Main.hs | 2 +- .../Development/IDE/Plugin/CodeAction/ExactPrint.hs | 12 +++++------- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index 3035f9fd73..63d8dd7ab7 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 && ghcVersion < GHC910 then 5 else 0) 3 (if ghcVersion >= GHC94 && ghcVersion < GHC910 then 8 else 14)] + reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], if ghcVersion >= GHC94 && ghcVersion < GHC910 then mkL bar 3 5 3 8 else mkL bar 3 0 3 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/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index 4a332e6693..7f1feddc11 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -65,7 +65,7 @@ codeActionTests = testGroup getActionByTitle "Add placeholders for 'g','h'" , goldenWithClass "Creates a placeholder when all top-level decls are indented" "T7" "" $ getActionByTitle "Add placeholders for 'g','h','i'" - ,goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ + , goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ getActionByTitle "Add placeholders for '==' with signature(s)" 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 422d564103..7326e2d7e2 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 @@ -50,13 +50,11 @@ import GHC (AddEpAnn (..), #if !MIN_VERSION_ghc(9,9,0) import Data.Default (Default (..)) -import GHC (EpaLocation (EpaDelta), - addAnns, ann) +import GHC (addAnns, ann) #endif #if MIN_VERSION_ghc(9,9,0) -import GHC (EpaLocation' (..), - NoAnn (..)) +import GHC (NoAnn (..)) #endif ------------------------------------------------------------------------------ @@ -349,11 +347,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) childRdr x :: LIE GhcPs = L ll' $ IEThingWith #if MIN_VERSION_ghc(9,9,0) - (Nothing, [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP noAnn]) + (Nothing, [AddEpAnn AnnOpenP d1, AddEpAnn AnnCloseP noAnn]) #elif MIN_VERSION_ghc(9,7,0) - (Nothing, addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) + (Nothing, addAnns mempty [AddEpAnn AnnOpenP d1, AddEpAnn AnnCloseP def] emptyComments) #else - (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) + (addAnns mempty [AddEpAnn AnnOpenP d1, AddEpAnn AnnCloseP def] emptyComments) #endif absIE NoIEWildcard [childLIE] #if MIN_VERSION_ghc(9,9,0) From 07080c0ef0e96e6e2481f60ad48c4e3badb39f31 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 3 Jun 2024 16:31:15 +0530 Subject: [PATCH 61/83] Remove retrie dep from hls-refactor-plugin --- haskell-language-server.cabal | 1 - .../Development/IDE/GHC/Compat/ExactPrint.hs | 20 ++++++----- .../src/Development/IDE/GHC/ExactPrint.hs | 25 +++++--------- .../src/Development/IDE/Plugin/CodeAction.hs | 34 +++++++++---------- .../Development/IDE/Plugin/CodeAction/Args.hs | 7 ++-- 5 files changed, 38 insertions(+), 49 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 4953356a75..3dda5b6b4f 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1651,7 +1651,6 @@ library hls-refactor-plugin , containers , ghc-exactprint < 1 || >= 1.4 , extra - , retrie , syb , hls-graph , dlist diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs index 453e5477ad..d8b86217d7 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs @@ -2,16 +2,18 @@ -- multiple ghc-exactprint versions, accepting that anything more ambitious is -- pretty much impossible with the GHC 9.2 redesign of ghc-exactprint module Development.IDE.GHC.Compat.ExactPrint - ( ExactPrint - , exactPrint - , makeDeltaAst - , Retrie.Annotated, pattern Annotated, astA, annsA + ( module ExactPrint + , printA + , transformA ) where -import Development.IDE.GHC.Compat.Parser -import Language.Haskell.GHC.ExactPrint as Retrie -import qualified Retrie.ExactPrint as Retrie +import Language.Haskell.GHC.ExactPrint as ExactPrint +printA :: (ExactPrint ast) => ast -> String +printA ast = exactPrint ast -pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast -pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA)) +transformA + :: Monad m => ast1 -> (ast1 -> TransformT m ast2) -> m ast2 +transformA ast f = do + (ast',_ ,_) <- runTransformFromT 0 (f ast) + return $ ast' 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 4caae00bf1..09a79b8351 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -79,11 +79,6 @@ import Ide.Logger (Pretty (pretty), import Ide.PluginUtils import Language.Haskell.GHC.ExactPrint.Parsers import Language.LSP.Protocol.Types -import Retrie.ExactPrint hiding (parseDecl, - parseExpr, - parsePattern, - parseType) - import Control.Lens (_last, (&)) import Control.Lens.Operators ((%~)) @@ -141,33 +136,29 @@ instance Pretty Log where pretty = \case LogShake shakeLog -> pretty shakeLog -instance Show (Annotated ParsedSource) where - show _ = "" - -instance NFData (Annotated ParsedSource) where - rnf = rwhnf - data GetAnnotatedParsedSource = GetAnnotatedParsedSource deriving (Eq, Show, Typeable, GHC.Generic) instance Hashable GetAnnotatedParsedSource instance NFData GetAnnotatedParsedSource -type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource +type instance RuleResult GetAnnotatedParsedSource = ParsedSource +instance Show (HsModule GhcPs) where + show _ = "" + -- | Get the latest version of the annotated parse source with comments. getAnnotatedParsedSourceRule :: Recorder (WithPriority Log) -> Rules () getAnnotatedParsedSourceRule recorder = define (cmapWithPrio LogShake recorder) $ \GetAnnotatedParsedSource nfp -> do pm <- use GetParsedModuleWithComments nfp return ([], fmap annotateParsedSource pm) -annotateParsedSource :: ParsedModule -> Annotated ParsedSource -annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA +annotateParsedSource :: ParsedModule -> ParsedSource +annotateParsedSource (ParsedModule _ ps _ _) = #if MIN_VERSION_ghc(9,9,0) ps #else (makeDeltaAst ps) #endif - 0 ------------------------------------------------------------------------------ @@ -220,7 +211,7 @@ transform :: ClientCapabilities -> VersionedTextDocumentIdentifier -> Graft (Either String) ParsedSource -> - Annotated ParsedSource -> + ParsedSource -> Either String WorkspaceEdit transform dflags ccs verTxtDocId f a = do let src = printA a @@ -237,7 +228,7 @@ transformM :: ClientCapabilities -> VersionedTextDocumentIdentifier -> Graft (ExceptStringT m) ParsedSource -> - Annotated ParsedSource -> + ParsedSource -> m (Either String WorkspaceEdit) transformM dflags ccs verTextDocId f a = runExceptT $ runExceptString $ do 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 5a7c1b21d8..e76ef72d08 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -372,7 +372,7 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- imported from ‘Data.ByteString’ at B.hs:6:1-22 -- imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27 -- imported from ‘Data.Text’ at B.hs:7:1-16 -suggestHideShadow :: Annotated ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] +suggestHideShadow :: ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range} | Just [identifier, modName, s] <- matchRegexUnifySpaces @@ -390,7 +390,7 @@ suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range} result <> [hideAll] | otherwise = [] where - L _ HsModule {hsmodImports} = astA ps + L _ HsModule {hsmodImports} = ps suggests identifier modName s | Just tcM <- mTcM, @@ -1037,7 +1037,7 @@ isPreludeImplicit = xopt Lang.ImplicitPrelude suggestImportDisambiguation :: DynFlags -> Maybe T.Text -> - Annotated ParsedSource -> + ParsedSource -> T.Text -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] @@ -1053,7 +1053,7 @@ suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..} suggestions ambiguous modules (isJust local) | otherwise = [] where - L _ HsModule {hsmodImports} = astA ps + L _ HsModule {hsmodImports} = ps locDic = fmap (NE.fromList . DL.toList) $ @@ -1151,7 +1151,7 @@ targetModuleName (ExistingImp (L _ ImportDecl{..} :| _)) = unLoc ideclName disambiguateSymbol :: - Annotated ParsedSource -> + ParsedSource -> T.Text -> Diagnostic -> T.Text -> @@ -1211,7 +1211,7 @@ suggestFixConstructorImport Diagnostic{_range=_range,..} in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)] | otherwise = [] -suggestAddRecordFieldImport :: ExportsMap -> DynFlags -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] +suggestAddRecordFieldImport :: ExportsMap -> DynFlags -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] suggestAddRecordFieldImport exportsMap df ps fileContents Diagnostic {..} | Just fieldName <- findMissingField _message , Just (range, indent) <- newImportInsertRange ps fileContents @@ -1430,7 +1430,7 @@ removeRedundantConstraints df (makeDeltaAst -> L _ HsModule {hsmodDecls}) Diagno ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] +suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnostic {_message} | Just [methodName, className] <- matchRegexUnifySpaces @@ -1444,7 +1444,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos where suggest identInfo | importStyle <- NE.toList $ importStyles identInfo, - mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc . astA $ ps) (T.unpack moduleText) = + mImportDecl <- findImportDeclByModuleName (hsmodImports . unLoc $ ps) (T.unpack moduleText) = case mImportDecl of -- extend Just decl -> @@ -1467,7 +1467,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos | otherwise -> [] where moduleText = moduleNameText identInfo -suggestNewImport :: DynFlags -> ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] +suggestNewImport :: DynFlags -> ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg @@ -1509,7 +1509,7 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} qualify q (NotInScopeTypeConstructorOrClass d) = NotInScopeTypeConstructorOrClass (q <> "." <> d) qualify q (NotInScopeThing d) = NotInScopeThing (q <> "." <> d) - L _ HsModule {..} = astA ps + L _ HsModule {..} = ps suggestNewImport _ _ _ _ _ = [] {- | @@ -1626,7 +1626,7 @@ simpleCompareImportSuggestion (ImportSuggestion s1 _ i1) (ImportSuggestion s2 _ newtype NewImport = NewImport {unNewImport :: T.Text} deriving (Show, Eq, Ord) -newImportToEdit :: NewImport -> Annotated ParsedSource -> T.Text -> Maybe (T.Text, TextEdit) +newImportToEdit :: NewImport -> ParsedSource -> T.Text -> Maybe (T.Text, TextEdit) newImportToEdit (unNewImport -> imp) ps fileContents | Just (range, indent) <- newImportInsertRange ps fileContents = Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " ")) @@ -1640,7 +1640,7 @@ newImportToEdit (unNewImport -> imp) ps fileContents -- * If the file has neither existing imports nor a module declaration, -- the import will be inserted at line zero if there are no pragmas, -- * otherwise inserted one line after the last file-header pragma -newImportInsertRange :: Annotated ParsedSource -> T.Text -> Maybe (Range, Int) +newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange ps fileContents | Just ((l, c), col) <- case hsmodImports of -- When there is no existing imports, we only cares about the line number, setting column and indent to zero. @@ -1650,19 +1650,19 @@ newImportInsertRange ps fileContents = Just (Range insertPos insertPos, col) | otherwise = Nothing where - L _ HsModule {..} = astA ps + L _ HsModule {..} = ps -- | Find the position for a new import when there isn't an existing one. -- * If there is a module declaration, a new import should be inserted under the module declaration (including exports list) -- * Otherwise, a new import should be inserted after any file-header pragma. -findPositionNoImports :: Annotated ParsedSource -> T.Text -> Maybe Int +findPositionNoImports :: ParsedSource -> T.Text -> Maybe Int findPositionNoImports ps fileContents = maybe (Just (findNextPragmaPosition fileContents)) (findPositionAfterModuleName ps) hsmodName where - L _ HsModule {..} = astA ps + L _ HsModule {..} = ps -- | find line number right after module ... where -findPositionAfterModuleName :: Annotated ParsedSource +findPositionAfterModuleName :: ParsedSource -> LocatedA ModuleName -> Maybe Int findPositionAfterModuleName ps _hsmodName' = do @@ -1684,7 +1684,7 @@ findPositionAfterModuleName ps _hsmodName' = do Just $ srcLocLine (realSrcSpanEnd prevSrcSpan') + lineOffset #endif where - L _ HsModule {..} = astA ps + L _ HsModule {..} = ps -- The relative position of 'where' keyword (in lines, relative to the previous AST node). -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions. diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index 7601b4f9e7..a2e7c79e06 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -141,7 +141,7 @@ data CodeActionArgs = CodeActionArgs caaParsedModule :: IO (Maybe ParsedModule), caaContents :: IO (Maybe T.Text), caaDf :: IO (Maybe DynFlags), - caaAnnSource :: IO (Maybe (Annotated ParsedSource)), + caaAnnSource :: IO (Maybe ParsedSource), caaTmr :: IO (Maybe TcModuleResult), caaHar :: IO (Maybe HieAstResult), caaBindings :: IO (Maybe Bindings), @@ -254,12 +254,9 @@ instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where instance ToCodeAction r => ToCodeAction (DynFlags -> r) where toCodeAction = toCodeAction2 caaDf -instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where +instance ToCodeAction r => ToCodeAction (Maybe ParsedSource -> r) where toCodeAction = toCodeAction1 caaAnnSource -instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where - toCodeAction = toCodeAction2 caaAnnSource - instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where toCodeAction = toCodeAction1 caaTmr From 61403b1f197379ce9e4c3c80f433a0c5997cd947 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 3 Jun 2024 16:55:17 +0530 Subject: [PATCH 62/83] More retrie fixes --- plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs | 2 +- plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs | 2 +- plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index c6452441f2..c4c91fc3b9 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -150,7 +150,7 @@ getSrcEdit state verTxtDocId updatePs = do nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) annAst <- runActionE "Rename.GetAnnotatedParsedSource" state (useE GetAnnotatedParsedSource nfp) - let ps = astA annAst + let ps = annAst src = T.pack $ exactPrint ps res = T.pack $ exactPrint (updatePs ps) pure $ diffText ccs (verTxtDocId, src) res IncludeDeletions diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index f1b865e446..6f58cea8b3 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -222,7 +222,7 @@ runRetrieInlineThisCmd recorder state _token RunRetrieInlineThisParams{..} = do useE GetAnnotatedParsedSource nfpSource let fromRange = rangeToRealSrcSpan nfpSource $ getLocationRange inlineFromThisLocation intoRange = rangeToRealSrcSpan nfp $ getLocationRange inlineIntoThisLocation - inlineRewrite <- liftIO $ constructInlineFromIdentifer astSrc fromRange + inlineRewrite <- liftIO $ constructInlineFromIdentifer (unsafeMkA astSrc 0) fromRange when (null inlineRewrite) $ throwError $ PluginInternalError "Empty rewrite" (session, _) <- runActionE "retrie" state $ useWithStaleE GhcSessionDeps nfp diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 4a62f1cec4..f7212ab456 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -212,7 +212,7 @@ setupHscEnv :: IdeState -> NormalizedFilePath -> ParsedModule - -> ExceptT PluginError IO (Annotated ParsedSource, HscEnv, DynFlags) + -> ExceptT PluginError IO (ParsedSource, HscEnv, DynFlags) setupHscEnv ideState fp pm = do hscEnvEq <- runActionE "expandTHSplice.fallback.ghcSessionDeps" ideState $ useE GhcSessionDeps fp @@ -366,7 +366,7 @@ manualCalcEdit :: ClientCapabilities -> ReportEditor -> Range -> - Annotated ParsedSource -> + ParsedSource -> HscEnv -> TcGblEnv -> RealSrcSpan -> From ea62173389959b298e2b81bb928f4a65138aa22e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 8 Jun 2024 14:26:30 +0200 Subject: [PATCH 63/83] Fix cabal-plugin-tests by respecting maxCompletions client cfg + a bit of CPP --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 ++-- .../src/Ide/Plugin/Cabal/LicenseSuggest.hs | 25 +++++++++---------- plugins/hls-cabal-plugin/test/Main.hs | 17 ++++++++++--- 3 files changed, 28 insertions(+), 19 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index c483ddc1d5..e34d33561b 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -225,8 +225,9 @@ kick = do -- ---------------------------------------------------------------- licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = - pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction uri) +licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = do + maxCompls <- maxCompletions <$> lift getClientConfig + pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri) -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs index c8f2f29ec6..2324cac7fd 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -31,13 +31,12 @@ import qualified Text.Fuzzy.Parallel as Fuzzy -- with a suggestion, then return a 'CodeAction' for replacing the -- the incorrect license identifier with the suggestion. licenseErrorAction - :: Uri - -- ^ File for which the diagnostic was generated - -> Diagnostic - -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' + :: Int -- ^ Maximum number of suggestions to return + -> Uri -- ^ File for which the diagnostic was generated + -> Diagnostic -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' -> [CodeAction] -licenseErrorAction uri diag = - mkCodeAction <$> licenseErrorSuggestion (_message diag) +licenseErrorAction maxCompletions uri diag = + mkCodeAction <$> licenseErrorSuggestion maxCompletions (_message diag) where mkCodeAction (original, suggestion) = let @@ -66,22 +65,22 @@ licenseNames = map (T.pack . licenseId) [minBound .. maxBound] -- Results are sorted by best fit, and prefer solutions that have smaller -- length distance to the original word. -- --- >>> take 2 $ licenseErrorSuggestion (T.pack "Unknown SPDX license identifier: 'BSD3'") +-- >>> licenseErrorSuggestion 2 (T.pack "Unknown SPDX license identifier: 'BSD3'") -- [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")] licenseErrorSuggestion :: - T.Text - -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' + Int -- ^ Maximum number of suggestions to return + -> T.Text -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' -> [(T.Text, T.Text)] -- ^ (Original (incorrect) license identifier, suggested replacement) -licenseErrorSuggestion msg = +licenseErrorSuggestion maxCompletions msg = (getMatch <$> msg =~~ regex) >>= \case [original] -> - let matches = map Fuzzy.original $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults original licenseNames - in [(original,candidate) | candidate <- List.sortBy (lengthDistance original) matches] + let matches = map Fuzzy.original $ Fuzzy.simpleFilter Fuzzy.defChunkSize maxCompletions original licenseNames + in [(original,candidate) | candidate <- List.sortOn (lengthDistance original) matches] _ -> [] where regex :: T.Text regex = "Unknown SPDX license identifier: '(.*)'" getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] getMatch (_, _, _, results) = results - lengthDistance original x1 x2 = abs (T.length original - T.length x1) `compare` abs (T.length original - T.length x2) + lengthDistance original x = abs $ T.length original - T.length x diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 132abb5162..6488e71e16 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} @@ -60,15 +61,23 @@ codeActionUnitTests = "Code Action Tests" [ testCase "Unknown format" $ do -- the message has the wrong format - licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [] + licenseErrorSuggestion maxCompletions "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= [] , testCase "BSD-3-Clause" $ do - take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?") - @?= [("BSD3", "BSD-3-Clause"), ("BSD3", "BSD-3-Clause-LBNL")] + take 2 (licenseErrorSuggestion maxCompletions "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?") + @?= +-- Cabal-syntax 3.12.0.0 added bunch of new licenses, so now more licenses match "BSD3" pattern +#if MIN_VERSION_Cabal_syntax(3,12,0) + [("BSD3", "BSD-4.3RENO"), ("BSD3", "BSD-3-Clause")] +#else + [("BSD3", "BSD-3-Clause"), ("BSD3", "BSD-3-Clause-LBNL")] +#endif , testCase "MiT" $ do -- contains no suggestion - take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'") + take 2 (licenseErrorSuggestion maxCompletions "Unknown SPDX license identifier: 'MiT'") @?= [("MiT", "MIT"), ("MiT", "MIT-0")] ] + where + maxCompletions = 100 -- ------------------------ ------------------------------------------------ -- Integration Tests From f687205d8d3894de305c2ec4e5d091c8fa228fe5 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Mon, 10 Jun 2024 13:55:15 +0100 Subject: [PATCH 64/83] Fixup ghcide-tests --- .../cabal/Development/IDE/Test/Runfiles.hs | 9 - ghcide/test/exe/CompletionTests.hs | 6 +- ghcide/test/exe/TestUtils.hs | 191 ------------------ 3 files changed, 2 insertions(+), 204 deletions(-) delete mode 100644 ghcide/test/cabal/Development/IDE/Test/Runfiles.hs delete mode 100644 ghcide/test/exe/TestUtils.hs diff --git a/ghcide/test/cabal/Development/IDE/Test/Runfiles.hs b/ghcide/test/cabal/Development/IDE/Test/Runfiles.hs deleted file mode 100644 index 83b7e8c368..0000000000 --- a/ghcide/test/cabal/Development/IDE/Test/Runfiles.hs +++ /dev/null @@ -1,9 +0,0 @@ --- Copyright (c) 2019 The DAML Authors. All rights reserved. --- SPDX-License-Identifier: Apache-2.0 - -module Development.IDE.Test.Runfiles - ( locateGhcideExecutable - ) where - -locateGhcideExecutable :: IO FilePath -locateGhcideExecutable = pure "ghcide" diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index 99008f13ec..5a9da9f7fd 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -16,7 +16,6 @@ import Data.Default import Data.List.Extra import Data.Maybe import qualified Data.Text as T -import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import Development.IDE.Types.Location import Ide.Plugin.Config import qualified Language.LSP.Protocol.Lens as L @@ -30,10 +29,9 @@ import Language.LSP.Test import Test.Hls (waitForTypecheck) import qualified Test.Hls.FileSystem as FS import Test.Hls.FileSystem (file, text) -import Test.Hls.Util (knownBrokenOnWindows) +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit -import TestUtils tests :: TestTree @@ -277,7 +275,7 @@ nonLocalCompletionTests = ] where brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason" - brokenForWinOldGhc = knownBrokenFor (BrokenSpecific Windows [GHC92 .. GHC98]) "Windows (GHC <= 9.8) has strange things in scope for some reason" + brokenForWinOldGhc = knownBrokenInEnv ([HostOS Windows] ++ (map GhcVer [GHC92 .. GHC98])) "Windows (GHC <= 9.8) has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [ diff --git a/ghcide/test/exe/TestUtils.hs b/ghcide/test/exe/TestUtils.hs deleted file mode 100644 index 7d40d64c49..0000000000 --- a/ghcide/test/exe/TestUtils.hs +++ /dev/null @@ -1,191 +0,0 @@ -{-# LANGUAGE GADTs #-} - -module TestUtils where - -import Control.Exception (bracket_) -import Data.Foldable -import Data.Maybe -import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) -import Development.IDE.Test (configureCheckProject, - expectNoMoreDiagnostics) -import Development.IDE.Test.Runfiles -import Development.IDE.Types.Location -import Development.Shake (getDirectoryFilesIO) -import Language.LSP.Protocol.Types hiding - (SemanticTokenAbsolute (..), - SemanticTokenRelative (..), - SemanticTokensEdit (..), - mkRange) -import Language.LSP.Test -import System.Directory -import System.Environment.Blank (getEnv, setEnv, unsetEnv) -import System.FilePath -import System.Info.Extra (isMac, isWindows) -import qualified System.IO.Extra -import Test.Tasty -import Test.Tasty.ExpectedFailure -import Test.Tasty.HUnit - -import Config (lspTestCaps) - - -run :: Session a -> IO a -run s = run' (const s) - -run' :: (FilePath -> Session a) -> IO a -run' s = withTempDir $ \dir -> runInDir dir (s dir) - -runInDir :: FilePath -> Session a -> IO a -runInDir dir = runInDir' dir "." "." [] - --- | Takes a directory as well as relative paths to where we should launch the executable as well as the session root. -runInDir' :: FilePath -> FilePath -> FilePath -> [String] -> Session a -> IO a -runInDir' = runInDir'' lspTestCaps - -runInDir'' - :: ClientCapabilities - -> FilePath - -> FilePath - -> FilePath - -> [String] - -> Session b - -> IO b -runInDir'' lspCaps dir startExeIn startSessionIn extraOptions s = do - - ghcideExe <- locateGhcideExecutable - let startDir = dir startExeIn - let projDir = dir startSessionIn - - createDirectoryIfMissing True startDir - createDirectoryIfMissing True projDir - -- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56 - -- since the package import test creates "Data/List.hs", which otherwise has no physical home - createDirectoryIfMissing True $ projDir ++ "/Data" - - shakeProfiling <- getEnv "SHAKE_PROFILING" - let cmd = unwords $ - [ghcideExe, "--lsp", "--test", "--verify-core-file", "--verbose", "-j2", "--cwd", startDir - ] ++ ["--shake-profiling=" <> dir | Just dir <- [shakeProfiling] - ] ++ extraOptions - -- HIE calls getXgdDirectory which assumes that HOME is set. - -- Only sets HOME if it wasn't already set. - setEnv "HOME" "/homeless-shelter" False - conf <- getConfigFromEnv - runSessionWithConfig conf cmd lspCaps projDir $ do - configureCheckProject False - s - --- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path --- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or --- @/var@ -withTempDir :: (FilePath -> IO a) -> IO a -withTempDir f = System.IO.Extra.withTempDir $ \dir -> do - dir' <- canonicalizePath dir - f dir' - -getConfigFromEnv :: IO SessionConfig -getConfigFromEnv = do - logColor <- fromMaybe True <$> checkEnv "LSP_TEST_LOG_COLOR" - timeoutOverride <- fmap read <$> getEnv "LSP_TIMEOUT" - return defaultConfig - { messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride - , logColor - } - where - checkEnv :: String -> IO (Maybe Bool) - checkEnv s = fmap convertVal <$> getEnv s - convertVal "0" = False - convertVal _ = True - -testSessionWait :: HasCallStack => String -> Session () -> TestTree -testSessionWait name = testSession name . - -- Check that any diagnostics produced were already consumed by the test case. - -- - -- If in future we add test cases where we don't care about checking the diagnostics, - -- this could move elsewhere. - -- - -- Experimentally, 0.5s seems to be long enough to wait for any final diagnostics to appear. - ( >> expectNoMoreDiagnostics 0.5) - -testSession :: String -> Session () -> TestTree -testSession name = testCase name . run - -xfail :: TestTree -> String -> TestTree -xfail = flip expectFailBecause - -ignoreInWindowsBecause :: String -> TestTree -> TestTree -ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows) - -knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree -knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers) - -data BrokenOS = Linux | MacOS | Windows deriving (Show) - -data IssueSolution = Broken | Ignore deriving (Show) - -data BrokenTarget = - BrokenSpecific BrokenOS [GhcVersion] - -- ^Broken for `BrokenOS` with `GhcVersion` - | BrokenForOS BrokenOS - -- ^Broken for `BrokenOS` - | BrokenForGHC [GhcVersion] - -- ^Broken for `GhcVersion` - deriving (Show) - --- | Ignore test for specific os and ghc with reason. -ignoreFor :: BrokenTarget -> String -> TestTree -> TestTree -ignoreFor = knownIssueFor Ignore - --- | Known broken for specific os and ghc with reason. -knownBrokenFor :: BrokenTarget -> String -> TestTree -> TestTree -knownBrokenFor = knownIssueFor Broken - --- | Deal with `IssueSolution` for specific OS and GHC. -knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree -knownIssueFor solution = go . \case - BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers - BrokenForOS bos -> isTargetOS bos - BrokenForGHC vers -> isTargetGhc vers - where - isTargetOS = \case - Windows -> isWindows - MacOS -> isMac - Linux -> not isWindows && not isMac - - isTargetGhc = elem ghcVersion - - go True = case solution of - Broken -> expectFailBecause - Ignore -> ignoreTestBecause - go False = const id - - - -testSessionWithExtraFiles :: FilePath -> String -> (FilePath -> Session ()) -> TestTree -testSessionWithExtraFiles prefix name = testCase name . runWithExtraFiles prefix - -testSession' :: String -> (FilePath -> Session ()) -> TestTree -testSession' name = testCase name . run' - - - -mkRange :: UInt -> UInt -> UInt -> UInt -> Range -mkRange a b c d = Range (Position a b) (Position c d) - - -runWithExtraFiles :: FilePath -> (FilePath -> Session a) -> IO a -runWithExtraFiles prefix s = withTempDir $ \dir -> do - copyTestDataFiles dir prefix - runInDir dir (s dir) - -copyTestDataFiles :: FilePath -> FilePath -> IO () -copyTestDataFiles dir prefix = do - -- Copy all the test data files to the temporary workspace - testDataFiles <- getDirectoryFilesIO ("ghcide/test/data" prefix) ["//*"] - for_ testDataFiles $ \f -> do - createDirectoryIfMissing True $ dir takeDirectory f - copyFile ("ghcide/test/data" prefix f) (dir f) - -withLongTimeout :: IO a -> IO a -withLongTimeout = bracket_ (setEnv "LSP_TIMEOUT" "120" True) (unsetEnv "LSP_TIMEOUT") - From 4efb898200f92603ce4410b13dcde8cc92e19fd7 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 10 Jun 2024 15:27:51 +0200 Subject: [PATCH 65/83] disable retrie, splice and floskell plugins for 9.10 --- cabal.project | 14 ++------------ haskell-language-server.cabal | 2 +- .../src/Development/IDE/GHC/Dump.hs | 4 +++- 3 files changed, 6 insertions(+), 14 deletions(-) diff --git a/cabal.project b/cabal.project index 2d863bbf8f..8b84a4a457 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-06-08T11:25:44Z +index-state: 2024-06-10T12:08:58Z tests: True test-show-details: direct @@ -45,14 +45,6 @@ constraints: if impl(ghc >= 9.9) benchmarks: False - source-repository-package - type:git - location: https://github.com/wz1000/retrie.git - tag: 2f089092a563b06eccf196751782f1d70000d589 - source-repository-package - type:git - location: https://github.com/jhrcek/floskell.git - tag: dbb5005bf92dbfa5ebd7dba6df1a235d01721782 constraints: lens >= 5.3.2, -- See @@ -60,7 +52,7 @@ if impl(ghc >= 9.9) -- https://github.com/fourmolu/fourmolu/issues/412 -- https://github.com/ennocramer/floskell/pull/82 -- https://github.com/ndmitchell/hlint/pull/1594 - haskell-language-server -stylishHaskell -fourmolu -hlint, + haskell-language-server -stylishHaskell -fourmolu -hlint -retrie -splice -floskell, allow-newer: entropy:base, entropy:directory, @@ -68,8 +60,6 @@ if impl(ghc >= 9.9) entropy:process, haddock-library:base, haddock-library:containers, - hiedb:base, - hiedb:ghc, -- These can be removed when we get a new lsp release quickcheck-instances:base, quickcheck-instances:containers, diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 01f2926672..1676d17aec 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -323,7 +323,7 @@ library hls-class-plugin , deepseq , extra , ghc - , ghc-exactprint >= 1.5 + , ghc-exactprint >= 1.5 && < 1.10.0.0 , ghcide == 2.8.0.0 , hls-graph , hls-plugin-api == 2.8.0.0 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 8aee3d5bad..7958697dfc 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -4,7 +4,9 @@ import qualified Data.ByteString as B import Data.Data hiding (Fixity) import Development.IDE.GHC.Compat hiding (LocatedA, NameAnn) -import Development.IDE.GHC.Compat.ExactPrint +import Development.IDE.GHC.Compat.ExactPrint hiding ( showAstData + , NoBlankEpAnnotations + , NoBlankSrcSpan) import Development.IDE.GHC.Compat.Util import Generics.SYB (ext1Q, ext2Q, extQ) import GHC.Hs hiding (AnnLet) From 1b405cc6be9b96a95509d3d59265b4cbdf6e2e64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 09:22:35 +0200 Subject: [PATCH 66/83] Update tested-with + fix import warning --- ghcide/ghcide.cabal | 2 +- haskell-language-server.cabal | 2 +- plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs | 3 +-- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 864791d25c..6301557f97 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -14,7 +14,7 @@ homepage: https://github.com/haskell/haskell-language-server/tree/master/ghcide#readme bug-reports: https://github.com/haskell/haskell-language-server/issues -tested-with: GHC ==9.8.2 || ==9.6.5 || ==9.4.8 || ==9.2.8 +tested-with: GHC ==9.10.1 || ==9.8.2 || ==9.6.5 || ==9.4.8 || ==9.2.8 extra-source-files: CHANGELOG.md README.md diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 1676d17aec..50aaf361b4 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -14,7 +14,7 @@ copyright: The Haskell IDE Team license: Apache-2.0 license-file: LICENSE build-type: Simple -tested-with: GHC ==9.8.2 || ==9.6.5 || ==9.4.8 || ==9.2.8 +tested-with: GHC ==9.10.1 || ==9.8.2 || ==9.6.5 || ==9.4.8 || ==9.2.8 extra-source-files: README.md ChangeLog.md diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index e910f7606d..fdf46d480b 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -18,7 +18,6 @@ import GHC.Parser.Annotation (AddEpAnn (..), EpAnn (..), EpAnnComments (EpaComments)) import Ide.PluginUtils (subRange) -import Language.Haskell.GHC.ExactPrint (d1) import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -36,7 +35,7 @@ import GHC.Parser.Annotation (Anchor (Anchor), AnchorOperation (MovedAnchor), SrcSpanAnn' (SrcSpanAnn), spanAsAnchor) -import Language.Haskell.GHC.ExactPrint (showAst) +import Language.Haskell.GHC.ExactPrint (d1, showAst) #endif #if MIN_VERSION_ghc(9,9,0) From 9d45176761f75ba923c0bc025e10c2e01870a781 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 10:01:22 +0200 Subject: [PATCH 67/83] Fix stylish --- .../src/Ide/Plugin/Cabal/LicenseSuggest.hs | 2 +- plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs | 1 - .../src/Ide/Plugin/OverloadedRecordDot.hs | 22 ++++++++----------- .../src/Development/IDE/GHC/Dump.hs | 4 +--- 4 files changed, 11 insertions(+), 18 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs index 2324cac7fd..7da1277289 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs @@ -36,7 +36,7 @@ licenseErrorAction -> Diagnostic -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' -> [CodeAction] licenseErrorAction maxCompletions uri diag = - mkCodeAction <$> licenseErrorSuggestion maxCompletions (_message diag) + mkCodeAction <$> licenseErrorSuggestion maxCompletions (_message diag) where mkCodeAction (original, suggestion) = let diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index fdf46d480b..7db7b0378f 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -35,7 +35,6 @@ import GHC.Parser.Annotation (Anchor (Anchor), AnchorOperation (MovedAnchor), SrcSpanAnn' (SrcSpanAnn), spanAsAnchor) -import Language.Haskell.GHC.ExactPrint (d1, showAst) #endif #if MIN_VERSION_ghc(9,9,0) 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 3361560820..d5dcde3c2a 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 @@ -36,24 +36,12 @@ import Development.IDE.Core.RuleTypes (TcModuleResult (..), import Development.IDE.Core.Shake (define, useWithStale) import qualified Development.IDE.Core.Shake as Shake -#if __GLASGOW_HASKELL__ >= 903 -import Development.IDE.GHC.Compat (HsExpr (HsRecSel)) -#else -import Development.IDE.GHC.Compat (HsExpr (HsRecFld)) -#endif - import Control.DeepSeq (rwhnf) import Development.IDE.Core.PluginUtils 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), + GhcPass, HsExpr (..), LHsExpr, Pass (..), appPrec, dollarName, getLoc, hs_valds, @@ -91,6 +79,14 @@ import Language.LSP.Protocol.Types (CodeAction (..), WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (..)) + +#if __GLASGOW_HASKELL__ < 910 +import Development.IDE.GHC.Compat (HsExpansion (HsExpanded)) +#else +import Development.IDE.GHC.Compat (XXExprGhcRn (..)) +#endif + + data Log = LogShake Shake.Log | LogCollectedRecordSelectors [RecordSelectorExpr] 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 7958697dfc..949e2a700b 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -4,9 +4,7 @@ import qualified Data.ByteString as B import Data.Data hiding (Fixity) import Development.IDE.GHC.Compat hiding (LocatedA, NameAnn) -import Development.IDE.GHC.Compat.ExactPrint hiding ( showAstData - , NoBlankEpAnnotations - , NoBlankSrcSpan) +import Development.IDE.GHC.Compat.ExactPrint (ExactPrint, exactPrint) import Development.IDE.GHC.Compat.Util import Generics.SYB (ext1Q, ext2Q, extQ) import GHC.Hs hiding (AnnLet) From b1447b62c9784f7ddfd69bd4790cd063c940e40b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 10:34:00 +0200 Subject: [PATCH 68/83] Fix compilation with 9.2.8, fix stack jobs --- .../Development/IDE/Plugin/CodeAction/Args.hs | 3 +- .../src/Ide/Plugin/Splice.hs | 74 +++++++++---------- 2 files changed, 34 insertions(+), 43 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index 1ddd54b952..cd1e301acc 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -28,7 +28,6 @@ import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.Shake import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.ExactPrint import Development.IDE.GHC.ExactPrint import Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite, rewriteToEdit) @@ -217,7 +216,7 @@ instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where #if !MIN_VERSION_ghc(9,3,0) toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} -> x >>= \case - Just s -> flip runReaderT caa . runExceptT . toCodeAction . f . astA $ s + Just s -> flip runReaderT caa . runExceptT . toCodeAction $ f s _ -> pure $ Right [] #else toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} -> diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index fd9c0993ba..6e913d8367 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -10,68 +10,60 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -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 (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) +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 (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.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 GHC.Exts -import qualified GHC.Types.Error as Error -import Ide.Plugin.Error (PluginError (PluginInternalError)) +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 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')) +import Data.Foldable (Foldable (foldl')) #endif #if MIN_VERSION_ghc(9,4,1) -import GHC.Data.Bag (Bag) +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 From 0a746f355faf4d6f0e85cfdb71ee34d769426bd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 10:36:38 +0200 Subject: [PATCH 69/83] Remove no longer relevant :type +v test --- plugins/hls-eval-plugin/test/Main.hs | 2 -- plugins/hls-eval-plugin/test/testdata/T15.expected.hs | 8 -------- plugins/hls-eval-plugin/test/testdata/T15.hs | 7 ------- 3 files changed, 17 deletions(-) delete mode 100644 plugins/hls-eval-plugin/test/testdata/T15.expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T15.hs diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index b88866b839..10158531d2 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -84,8 +84,6 @@ tests = , goldenWithEval "Shows a kind with :kind" "T12" "hs" , goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs" , goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069 - , knownBrokenForGhcVersions [GHC92 .. ] "type +v does not work anymore with 9.2" $ - goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" , goldenWithEval "Doesn't break in module containing main function" "T4139" "hs" , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs" , goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs" diff --git a/plugins/hls-eval-plugin/test/testdata/T15.expected.hs b/plugins/hls-eval-plugin/test/testdata/T15.expected.hs deleted file mode 100644 index 54f0f38ef5..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T15.expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeApplications #-} -module T15 where - -foo :: Show a => a -> String -foo = show - --- >>> :type +v foo @Int --- foo @Int :: Show Int => Int -> String diff --git a/plugins/hls-eval-plugin/test/testdata/T15.hs b/plugins/hls-eval-plugin/test/testdata/T15.hs deleted file mode 100644 index 684333fbbd..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T15.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE TypeApplications #-} -module T15 where - -foo :: Show a => a -> String -foo = show - --- >>> :type +v foo @Int From de8a31573670abc97faa0aeed040c8ae87253d2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 11:30:40 +0200 Subject: [PATCH 70/83] Disable tests of disabled plugins in CI --- .github/workflows/test.yml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index b86b6b8302..b31f1137a9 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -141,7 +141,7 @@ jobs: name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests @@ -157,7 +157,7 @@ jobs: name: Test hls-eval-plugin run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests @@ -165,7 +165,7 @@ jobs: name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests @@ -173,7 +173,7 @@ jobs: name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests @@ -189,7 +189,7 @@ jobs: name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests @@ -238,7 +238,7 @@ jobs: name: Test hls-cabal-plugin test suite run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests From e1e3085aa121c9e6cd3276f81b0728893f4ce15c Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 11 Jun 2024 10:50:58 +0100 Subject: [PATCH 71/83] Try a better broken specifier? --- ghcide/test/exe/CompletionTests.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index 5a9da9f7fd..6e129c5404 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -275,7 +275,10 @@ nonLocalCompletionTests = ] where brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason" - brokenForWinOldGhc = knownBrokenInEnv ([HostOS Windows] ++ (map GhcVer [GHC92 .. GHC98])) "Windows (GHC <= 9.8) has strange things in scope for some reason" + brokenForWinOldGhc = + knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC92] "Windows (GHC <= 9.8) has strange things in scope for some reason" + . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC94] "Windows (GHC <= 9.8) has strange things in scope for some reason" + . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC96] "Windows (GHC <= 9.8) has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [ From e64e117ac109b023e66fc9b0b36ede79512f7f6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 11:52:45 +0200 Subject: [PATCH 72/83] Fix invalid CI config --- .github/workflows/test.yml | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index b31f1137a9..263802ace4 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -98,7 +98,7 @@ jobs: - uses: ./.github/actions/setup-build with: ghc: ${{ matrix.ghc }} - os: ${{ runner.os }} + os: ${{ runner.os }} - name: Build run: cabal build all @@ -141,7 +141,8 @@ jobs: name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests - - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests @@ -157,7 +158,8 @@ jobs: name: Test hls-eval-plugin run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests - - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests @@ -165,7 +167,8 @@ jobs: name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests - - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests @@ -173,7 +176,8 @@ jobs: name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests @@ -189,7 +193,8 @@ jobs: name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests - - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests @@ -238,7 +243,8 @@ jobs: name: Test hls-cabal-plugin test suite run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests - - if: matrix.test && matrix.ghc != '9.10' -- TODO enable when it supports 9.10 + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests From 4f92fbf7b16399e46cf488c1952e25354a1baa7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 12:06:53 +0200 Subject: [PATCH 73/83] Use getClientConfigAction instead of introducing new HandlerM action --- hls-plugin-api/src/Ide/Types.hs | 6 +----- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 4 ++-- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 81a1d56cc3..f786b6aac9 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -31,7 +31,7 @@ module Ide.Types , PluginCommand(..), CommandId(..), CommandFunction, mkLspCommand, mkLspCmdId , PluginId(..) , PluginHandler(..), mkPluginHandler -, HandlerM, runHandlerM, pluginGetClientCapabilities, pluginGetVirtualFile, pluginGetVersionedTextDoc, pluginSendNotification, pluginSendRequest, pluginWithIndefiniteProgress, pluginGetConfig +, HandlerM, runHandlerM, pluginGetClientCapabilities, pluginGetVirtualFile, pluginGetVersionedTextDoc, pluginSendNotification, pluginSendRequest, pluginWithIndefiniteProgress , PluginHandlers(..) , PluginMethod(..) , PluginMethodHandler @@ -926,10 +926,6 @@ pluginGetVersionedTextDoc = HandlerM . getVersionedTextDoc pluginGetClientCapabilities :: HandlerM config ClientCapabilities pluginGetClientCapabilities = HandlerM getClientCapabilities --- | Wrapper of 'getConfig' for HandlerM -pluginGetConfig :: HandlerM config config -pluginGetConfig = HandlerM getConfig - -- | Wrapper of 'sendNotification for HandlerM -- -- TODO: Return notification in result instead of calling `sendNotification` directly diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index f341fded55..eb9fed55d7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -224,8 +224,8 @@ kick = do -- ---------------------------------------------------------------- licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = do - maxCompls <- maxCompletions <$> lift pluginGetConfig +licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = do + maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.suggestLicense" ideState getClientConfigAction pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri) -- ---------------------------------------------------------------- From 747b1c733c4ca3db3edc89f4c155c02369431df8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 12:15:06 +0200 Subject: [PATCH 74/83] Move CPPd imports to prevent stylish from evaluating CPP --- .../src/Ide/Plugin/ExplicitFields.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) 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 4036676834..a1a2017c8d 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,11 +35,6 @@ 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, @@ -86,6 +81,11 @@ import Language.LSP.Protocol.Types (CodeAction (..), WorkspaceEdit (WorkspaceEdit), type (|?) (InL, InR)) +#if __GLASGOW_HASKELL__ < 910 +import Development.IDE.GHC.Compat (HsExpansion (HsExpanded)) +#else +import Development.IDE.GHC.Compat (XXExprGhcRn (..)) +#endif data Log = LogShake Shake.Log From 8267cadaf0f2768a39c36726deb0cef1b4b96612 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Tue, 11 Jun 2024 12:56:28 +0200 Subject: [PATCH 75/83] Disable stan tests with ghc 9.10 in CI --- .github/workflows/test.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 263802ace4..fa851b03ff 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -163,7 +163,8 @@ jobs: name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests - - if: matrix.test && matrix.ghc != '9.2' + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.2' && matrix.ghc != '9.10' name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests From efad46c20e8a4d8cd97ef16f22b264d1d1eb03e7 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 12 Jun 2024 09:39:30 +0200 Subject: [PATCH 76/83] attempt fixing exactprint <9.10 --- .../src/Development/IDE/Plugin/CodeAction/Args.hs | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index cd1e301acc..0be04656bd 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -213,17 +213,7 @@ toCodeAction3 get f = ExceptT . ReaderT $ \caa -> get caa >>= flip runReaderT ca -- | this instance returns a delta AST, useful for exactprint transforms instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where -#if !MIN_VERSION_ghc(9,3,0) - toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} -> - x >>= \case - Just s -> flip runReaderT caa . runExceptT . toCodeAction $ f s - _ -> pure $ Right [] -#else - toCodeAction f = ExceptT . ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} -> - x >>= \case - Just s -> flip runReaderT caa . runExceptT . toCodeAction . f . pm_parsed_source $ s - _ -> pure $ Right [] -#endif + toCodeAction = toCodeAction2 caaAnnSource instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where toCodeAction = toCodeAction3 caaExportsMap From 7142686f62227f714ffa08da68926494fc8ea0ef Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Wed, 12 Jun 2024 10:50:58 +0100 Subject: [PATCH 77/83] Try enabling fourmolu now --- .github/workflows/test.yml | 3 +-- cabal.project | 5 ++--- haskell-language-server.cabal | 2 +- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index fa851b03ff..dbee2b7394 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -177,8 +177,7 @@ jobs: name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests diff --git a/cabal.project b/cabal.project index 8b84a4a457..f77791a7aa 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-06-10T12:08:58Z +index-state: 2024-06-13T00:00:00Z tests: True test-show-details: direct @@ -49,10 +49,9 @@ if impl(ghc >= 9.9) lens >= 5.3.2, -- See -- https://github.com/haskell/stylish-haskell/issues/479 - -- https://github.com/fourmolu/fourmolu/issues/412 -- https://github.com/ennocramer/floskell/pull/82 -- https://github.com/ndmitchell/hlint/pull/1594 - haskell-language-server -stylishHaskell -fourmolu -hlint -retrie -splice -floskell, + haskell-language-server -stylishHaskell -hlint -retrie -splice -floskell, allow-newer: entropy:base, entropy:directory, diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 50aaf361b4..233789d9c5 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1461,7 +1461,7 @@ library hls-fourmolu-plugin build-depends: , base >=4.12 && <5 , filepath - , fourmolu ^>= 0.14 || ^>= 0.15 + , fourmolu ^>= 0.14 || ^>= 0.15 || ^>= 0.16 , ghc-boot-th , ghcide == 2.8.0.0 , hls-plugin-api == 2.8.0.0 From eafeda805d8024c61f559058270677e717a83b75 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Wed, 12 Jun 2024 11:17:37 +0100 Subject: [PATCH 78/83] Revert "Try enabling fourmolu now" This reverts commit 7142686f62227f714ffa08da68926494fc8ea0ef. --- .github/workflows/test.yml | 3 ++- cabal.project | 5 +++-- haskell-language-server.cabal | 2 +- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index dbee2b7394..fa851b03ff 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -177,7 +177,8 @@ jobs: name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test + # TODO enable when it supports 9.10 + - if: matrix.test && matrix.ghc != '9.10' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests diff --git a/cabal.project b/cabal.project index f77791a7aa..8b84a4a457 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-06-13T00:00:00Z +index-state: 2024-06-10T12:08:58Z tests: True test-show-details: direct @@ -49,9 +49,10 @@ if impl(ghc >= 9.9) lens >= 5.3.2, -- See -- https://github.com/haskell/stylish-haskell/issues/479 + -- https://github.com/fourmolu/fourmolu/issues/412 -- https://github.com/ennocramer/floskell/pull/82 -- https://github.com/ndmitchell/hlint/pull/1594 - haskell-language-server -stylishHaskell -hlint -retrie -splice -floskell, + haskell-language-server -stylishHaskell -fourmolu -hlint -retrie -splice -floskell, allow-newer: entropy:base, entropy:directory, diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 233789d9c5..50aaf361b4 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1461,7 +1461,7 @@ library hls-fourmolu-plugin build-depends: , base >=4.12 && <5 , filepath - , fourmolu ^>= 0.14 || ^>= 0.15 || ^>= 0.16 + , fourmolu ^>= 0.14 || ^>= 0.15 , ghc-boot-th , ghcide == 2.8.0.0 , hls-plugin-api == 2.8.0.0 From dfe720d1407fbcc6d8225f36d199e2a0024146fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 13 Jun 2024 07:23:38 +0200 Subject: [PATCH 79/83] Update code-range-plugin tests --- plugins/hls-code-range-plugin/test/Main.hs | 7 +++- .../folding-range/Function.golden.txt.ghc910 | 42 +++++++++++++++++++ .../selection-range/Empty.golden.txt.ghc910 | 1 + .../Function.golden.txt.ghc910 | 4 ++ .../selection-range/Import.golden.txt.ghc910 | 2 + 5 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 plugins/hls-code-range-plugin/test/testdata/folding-range/Function.golden.txt.ghc910 create mode 100644 plugins/hls-code-range-plugin/test/testdata/selection-range/Empty.golden.txt.ghc910 create mode 100644 plugins/hls-code-range-plugin/test/testdata/selection-range/Function.golden.txt.ghc910 create mode 100644 plugins/hls-code-range-plugin/test/testdata/selection-range/Import.golden.txt.ghc910 diff --git a/plugins/hls-code-range-plugin/test/Main.hs b/plugins/hls-code-range-plugin/test/Main.hs index 88eac8eafd..5483b23abf 100644 --- a/plugins/hls-code-range-plugin/test/Main.hs +++ b/plugins/hls-code-range-plugin/test/Main.hs @@ -35,7 +35,7 @@ main = do ] selectionRangeGoldenTest :: TestName -> [(UInt, UInt)] -> TestTree -selectionRangeGoldenTest testName positions = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt") $ do +selectionRangeGoldenTest testName positions = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt" <> ghcSuffix) $ do res <- runSessionWithServer def plugin testDataDir $ do doc <- openDoc (testName <.> "hs") "haskell" resp <- request SMethod_TextDocumentSelectionRange $ SelectionRangeParams Nothing Nothing doc @@ -65,7 +65,7 @@ selectionRangeGoldenTest testName positions = goldenGitDiff testName (testDataDi showLBS = fromString . show foldingRangeGoldenTest :: TestName -> TestTree -foldingRangeGoldenTest testName = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt") $ do +foldingRangeGoldenTest testName = goldenGitDiff testName (testDataDir testName <.> "golden" <.> "txt" <> ghcSuffix) $ do res <- runSessionWithServer def plugin testDataDir $ do doc <- openDoc (testName <.> "hs") "haskell" resp <- request SMethod_TextDocumentFoldingRange $ FoldingRangeParams Nothing Nothing doc @@ -91,3 +91,6 @@ foldingRangeGoldenTest testName = goldenGitDiff testName (testDataDir testN showLBS = fromString . show showFRK = fromString . show + +ghcSuffix :: String +ghcSuffix = if ghcVersion >= GHC910 then ".ghc910" else "" \ No newline at end of file diff --git a/plugins/hls-code-range-plugin/test/testdata/folding-range/Function.golden.txt.ghc910 b/plugins/hls-code-range-plugin/test/testdata/folding-range/Function.golden.txt.ghc910 new file mode 100644 index 0000000000..937654b5b7 --- /dev/null +++ b/plugins/hls-code-range-plugin/test/testdata/folding-range/Function.golden.txt.ghc910 @@ -0,0 +1,42 @@ +((2, 7) : (2, 15)) : FoldingRangeKind_Region +((2, 16) : (2, 22)) : FoldingRangeKind_Region +((4, 0) : (7, 21)) : FoldingRangeKind_Region +((4, 0) : (4, 25)) : FoldingRangeKind_Region +((4, 0) : (4, 6)) : FoldingRangeKind_Region +((4, 10) : (4, 25)) : FoldingRangeKind_Region +((4, 10) : (4, 17)) : FoldingRangeKind_Region +((4, 21) : (4, 25)) : FoldingRangeKind_Region +((5, 0) : (7, 21)) : FoldingRangeKind_Region +((5, 0) : (5, 6)) : FoldingRangeKind_Region +((5, 7) : (5, 8)) : FoldingRangeKind_Region +((5, 9) : (7, 21)) : FoldingRangeKind_Region +((5, 11) : (7, 21)) : FoldingRangeKind_Region +((5, 14) : (5, 28)) : FoldingRangeKind_Region +((5, 14) : (5, 23)) : FoldingRangeKind_Region +((5, 14) : (5, 15)) : FoldingRangeKind_Region +((5, 16) : (5, 21)) : FoldingRangeKind_Region +((5, 22) : (5, 23)) : FoldingRangeKind_Region +((5, 24) : (5, 26)) : FoldingRangeKind_Region +((5, 27) : (5, 28)) : FoldingRangeKind_Region +((6, 16) : (6, 20)) : FoldingRangeKind_Region +((7, 16) : (7, 21)) : FoldingRangeKind_Region +((9, 0) : (12, 20)) : FoldingRangeKind_Region +((9, 0) : (9, 24)) : FoldingRangeKind_Region +((9, 0) : (9, 5)) : FoldingRangeKind_Region +((9, 9) : (9, 24)) : FoldingRangeKind_Region +((9, 9) : (9, 16)) : FoldingRangeKind_Region +((9, 20) : (9, 24)) : FoldingRangeKind_Region +((10, 0) : (12, 20)) : FoldingRangeKind_Region +((10, 0) : (10, 5)) : FoldingRangeKind_Region +((10, 6) : (10, 7)) : FoldingRangeKind_Region +((10, 8) : (12, 20)) : FoldingRangeKind_Region +((10, 10) : (12, 20)) : FoldingRangeKind_Region +((10, 13) : (10, 27)) : FoldingRangeKind_Region +((10, 13) : (10, 22)) : FoldingRangeKind_Region +((10, 13) : (10, 14)) : FoldingRangeKind_Region +((10, 15) : (10, 20)) : FoldingRangeKind_Region +((10, 21) : (10, 22)) : FoldingRangeKind_Region +((10, 23) : (10, 25)) : FoldingRangeKind_Region +((10, 26) : (10, 27)) : FoldingRangeKind_Region +((11, 16) : (11, 21)) : FoldingRangeKind_Region +((12, 16) : (12, 20)) : FoldingRangeKind_Region diff --git a/plugins/hls-code-range-plugin/test/testdata/selection-range/Empty.golden.txt.ghc910 b/plugins/hls-code-range-plugin/test/testdata/selection-range/Empty.golden.txt.ghc910 new file mode 100644 index 0000000000..7689c89086 --- /dev/null +++ b/plugins/hls-code-range-plugin/test/testdata/selection-range/Empty.golden.txt.ghc910 @@ -0,0 +1 @@ +(1,5) (1,5) \ No newline at end of file diff --git a/plugins/hls-code-range-plugin/test/testdata/selection-range/Function.golden.txt.ghc910 b/plugins/hls-code-range-plugin/test/testdata/selection-range/Function.golden.txt.ghc910 new file mode 100644 index 0000000000..eb359fb12b --- /dev/null +++ b/plugins/hls-code-range-plugin/test/testdata/selection-range/Function.golden.txt.ghc910 @@ -0,0 +1,4 @@ +(5,16) (5,20) => (5,16) (5,40) => (5,14) (5,40) => (5,1) (11,20) => (4,1) (11,20) => (3,1) (11,20) => (1,8) (14,15) +(5,12) (5,13) => (5,1) (11,20) => (4,1) (11,20) => (3,1) (11,20) => (1,8) (14,15) +(4,1) (4,9) => (4,1) (4,29) => (4,1) (11,20) => (3,1) (11,20) => (1,8) (14,15) +(3,1) (3,9) => (3,1) (3,61) => (3,1) (11,20) => (1,8) (14,15) \ No newline at end of file diff --git a/plugins/hls-code-range-plugin/test/testdata/selection-range/Import.golden.txt.ghc910 b/plugins/hls-code-range-plugin/test/testdata/selection-range/Import.golden.txt.ghc910 new file mode 100644 index 0000000000..4011ddb913 --- /dev/null +++ b/plugins/hls-code-range-plugin/test/testdata/selection-range/Import.golden.txt.ghc910 @@ -0,0 +1,2 @@ +(4,33) (4,38) => (4,32) (4,47) => (4,1) (4,47) => (3,1) (4,47) => (1,8) (4,47) +(1,8) (1,22) => (1,8) (4,47) \ No newline at end of file From 35a0002484363319802ef4a45a8ac3114229ccd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 13 Jun 2024 07:35:33 +0200 Subject: [PATCH 80/83] Fix No newline at the end of file --- plugins/hls-code-range-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-code-range-plugin/test/Main.hs b/plugins/hls-code-range-plugin/test/Main.hs index 5483b23abf..da32deed51 100644 --- a/plugins/hls-code-range-plugin/test/Main.hs +++ b/plugins/hls-code-range-plugin/test/Main.hs @@ -93,4 +93,4 @@ foldingRangeGoldenTest testName = goldenGitDiff testName (testDataDir testN showFRK = fromString . show ghcSuffix :: String -ghcSuffix = if ghcVersion >= GHC910 then ".ghc910" else "" \ No newline at end of file +ghcSuffix = if ghcVersion >= GHC910 then ".ghc910" else "" From db3aa95331c70e400482df011f1af8271600db2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Thu, 13 Jun 2024 08:47:29 +0200 Subject: [PATCH 81/83] Use more recent cabal-gild --- haskell-language-server.cabal | 2 +- .../test/testdata/lib_testdata.formatted_document.cabal | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 50aaf361b4..5324b13839 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -207,7 +207,7 @@ test-suite hls-cabal-gild-plugin-tests , hls-test-utils == 2.8.0.0 if flag(isolateCabalGildTests) - build-tool-depends: cabal-gild:cabal-gild ^>=1.1 + build-tool-depends: cabal-gild:cabal-gild ^>=1.3 cpp-options: -Dhls_isolate_cabalgild_tests ----------------------------- diff --git a/plugins/hls-cabal-gild-plugin/test/testdata/lib_testdata.formatted_document.cabal b/plugins/hls-cabal-gild-plugin/test/testdata/lib_testdata.formatted_document.cabal index f8ca530630..a29e590238 100644 --- a/plugins/hls-cabal-gild-plugin/test/testdata/lib_testdata.formatted_document.cabal +++ b/plugins/hls-cabal-gild-plugin/test/testdata/lib_testdata.formatted_document.cabal @@ -17,4 +17,5 @@ executable testdata testdata, hs-source-dirs: app - default-language: Haskell2010 + default-language: + Haskell2010 From 333d5b06e3dd0461b6f4ce04dde14c40f22df5c2 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Thu, 13 Jun 2024 11:27:21 +0100 Subject: [PATCH 82/83] Try setting some linker flags for macos --- haskell-language-server.cabal | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 5324b13839..09c934ed92 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1480,6 +1480,9 @@ test-suite hls-fourmolu-plugin-tests type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-fourmolu-plugin/test main-is: Main.hs + -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/24648 + if os(darwin) + ghc-options: -optl-Wl,-ld_classic build-tool-depends: fourmolu:fourmolu build-depends: @@ -1533,6 +1536,9 @@ test-suite hls-ormolu-plugin-tests type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-ormolu-plugin/test main-is: Main.hs + -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/24648 + if os(darwin) + ghc-options: -optl-Wl,-ld_classic build-tool-depends: ormolu:ormolu build-depends: From 531b1987177725715b439e6e6302de16f929d411 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 13 Jun 2024 15:31:27 +0200 Subject: [PATCH 83/83] Ignore non-local variable completion test on windows for GHC 9.8 --- ghcide/test/exe/CompletionTests.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index 6e129c5404..26d8d17fc2 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -276,9 +276,10 @@ nonLocalCompletionTests = where brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason" brokenForWinOldGhc = - knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC92] "Windows (GHC <= 9.8) has strange things in scope for some reason" - . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC94] "Windows (GHC <= 9.8) has strange things in scope for some reason" - . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC96] "Windows (GHC <= 9.8) has strange things in scope for some reason" + knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC92] "Windows (GHC == 9.2) has strange things in scope for some reason" + . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC94] "Windows (GHC == 9.4) has strange things in scope for some reason" + . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC96] "Windows (GHC == 9.6) has strange things in scope for some reason" + . knownBrokenInSpecificEnv [HostOS Windows, GhcVer GHC98] "Windows (GHC == 9.8) has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [