diff --git a/hls-eval-plugin.cabal b/hls-eval-plugin.cabal --- a/hls-eval-plugin.cabal +++ b/hls-eval-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-eval-plugin -version: 2.3.0.0 +version: 2.4.0.0 synopsis: Eval plugin for Haskell Language Server description: Please see the README on GitHub at @@ -67,10 +67,10 @@ , ghc , ghc-boot-th , ghc-paths - , ghcide == 2.3.0.0 + , ghcide == 2.4.0.0 , hashable , hls-graph - , hls-plugin-api == 2.3.0.0 + , hls-plugin-api == 2.4.0.0 , lens , lsp , lsp-types @@ -112,7 +112,7 @@ , filepath , hls-eval-plugin , hls-plugin-api - , hls-test-utils == 2.3.0.0 + , hls-test-utils == 2.4.0.0 , lens , lsp-types , text diff --git a/src/Ide/Plugin/Eval/CodeLens.hs b/src/Ide/Plugin/Eval/CodeLens.hs --- a/src/Ide/Plugin/Eval/CodeLens.hs +++ b/src/Ide/Plugin/Eval/CodeLens.hs @@ -59,7 +59,8 @@ import Development.IDE.GHC.Compat hiding (typeKind, unitState) import Development.IDE.GHC.Compat.Util (GhcException, - OverridingBool (..)) + OverridingBool (..), + bagToList) import Development.IDE.GHC.Util (evalGhcEnv, modifyDynFlags, printOutputable) @@ -266,7 +267,12 @@ addRdrEnv hmi | iface <- hm_iface hmi , ms_mod ms == mi_module iface - = hmi { hm_iface = iface { mi_globals = Just rdr_env } } + = hmi { hm_iface = iface { mi_globals = Just $! +#if MIN_VERSION_ghc(9,8,0) + forceGlobalRdrEnv +#endif + rdr_env + }} | otherwise = hmi return (ms, linkable_hsc) @@ -446,15 +452,14 @@ parseDynamicFlagsCmdLine ndf (map (L $ UnhelpfulSpan unhelpfulReason) flags) dbg "parsed flags" $ eans - <&> (_1 %~ showDynFlags >>> _3 %~ map warnMsg) + <&> (_1 %~ showDynFlags >>> _3 %~ prettyWarnings) case eans of Left err -> pure $ Just $ errorLines $ show err Right (df', ignoreds, warns) -> do let warnings = do guard $ not $ null warns pure $ errorLines $ - unlines $ - map prettyWarn warns + prettyWarnings warns igns = do guard $ not $ null ignoreds pure @@ -497,10 +502,18 @@ let opts = execOptions{execSourceFile = fp, execLineNumber = l} in myExecStmt stmt opts +#if MIN_VERSION_ghc(9,8,0) +prettyWarnings :: Messages DriverMessage -> String +prettyWarnings = printWithoutUniques . pprMessages (defaultDiagnosticOpts @DriverMessage) +#else +prettyWarnings :: [Warn] -> String +prettyWarnings = unlines . map prettyWarn + prettyWarn :: Warn -> String prettyWarn Warn{..} = T.unpack (printOutputable $ SrcLoc.getLoc warnMsg) <> ": warning:\n" <> " " <> SrcLoc.unLoc warnMsg +#endif needsQuickCheck :: [(Section, Test)] -> Bool needsQuickCheck = any (isProperty . snd) diff --git a/src/Ide/Plugin/Eval/Util.hs b/src/Ide/Plugin/Eval/Util.hs --- a/src/Ide/Plugin/Eval/Util.hs +++ b/src/Ide/Plugin/Eval/Util.hs @@ -59,7 +59,9 @@ logWithPos = let stk = toList callStack pr pos = concat [srcLocFile pos, ":", show . srcLocStartLine $ pos, ":", show . srcLocStartCol $ pos] - in if null stk then "" else pr . snd . head $ stk + in case stk of + [] -> "" + (x:_) -> pr $ snd x asT :: Show a => a -> T.Text asT = T.pack . show diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -93,8 +93,8 @@ ) , goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval' "Reports an error for an incorrect type with :kind" "T13" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") - , goldenWithEval "Returns a fully-instantiated type for :type" "T14" "hs" - , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "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' "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" , 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" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval "Reports an error when given with unknown command" "T18" "hs" @@ -134,7 +134,7 @@ , goldenWithEvalAndFs "Transitive local dependency" (FS.directProjectMulti ["TTransitive.hs", "TLocalImport.hs", "Util.hs"]) "TTransitive" "hs" -- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs" , goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs" - , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC92 then "ghc98.expected" else if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , testCase ":set -fprint-explicit-foralls works" $ do evalInFile "T8.hs" "-- >>> :t id" "-- id :: a -> a" evalInFile "T8.hs" "-- >>> :set -fprint-explicit-foralls\n-- >>> :t id" diff --git a/test/testdata/T14.ghc98.expected.hs b/test/testdata/T14.ghc98.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/T14.ghc98.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeApplications #-} +module T14 where + +foo :: Show a => a -> String +foo = show + +-- >>> :type foo @Int +-- foo @Int :: Show Int => Int -> String diff --git a/test/testdata/TFlags.ghc98.expected.hs b/test/testdata/TFlags.ghc98.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/TFlags.ghc98.expected.hs @@ -0,0 +1,62 @@ +-- Support for language options + +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Haskell2010 #-} + +module TFlags where + +-- Language options set in the module source (ScopedTypeVariables) +-- also apply to tests so this works fine +-- >>> f = (\(c::Char) -> [c]) + +{- Multiple options can be set with a single `:set` + +>>> :set -XMultiParamTypeClasses -XFlexibleInstances +>>> class Z a b c +-} + +{- + +Options apply only in the section where they are defined (unless they are in the setup section), so this will fail: + +>>> class L a b c +Too many parameters for class `L' +In the class declaration for `L' +-} + + +{- +Options apply to all tests in the same section after their declaration. + +Not set yet: + +>>> class D +No parameters for class `D' +In the class declaration for `D' + +Now it works: + +>>>:set -XMultiParamTypeClasses +>>> class C + +It still works + +>>> class F +-} + +{- Now -package flag is handled correctly: + +>>> :set -package ghc-prim +>>> import GHC.Prim + +-} + + +{- Invalid option/flags are reported, but valid ones will be reflected + +>>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all +: warning: [GHC-53692] [-Wdeprecated-flags (in -Wdefault)] + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. +Some flags have not been recognized: -XAbsent, -XWrong, -fprint-nothing-at-all + +-} diff --git a/test/testdata/TPropertyError.ghc96.expected.hs b/test/testdata/TPropertyError.ghc96.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/TPropertyError.ghc96.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/base/GHC/List.hs:1782:3 in base:GHC.List +-- errorEmptyList, called at libraries/base/GHC/List.hs:89:11 in base:GHC.List +-- badHead, called at libraries/base/GHC/List.hs:83:28 in base:GHC.List +-- head, called at :1:27 in interactive:Ghci2 +-- []