diff --git a/bench/config.yaml b/bench/config.yaml index a7d0365667..18211f4f24 100644 --- a/bench/config.yaml +++ b/bench/config.yaml @@ -106,6 +106,8 @@ experiments: - "code actions after cradle edit" - "documentSymbols after edit" - "hole fit suggestions" + - "eval execute single-line code lens" + - "eval execute multi-line code lens" # An ordered list of versions to analyze versions: diff --git a/ghcide-bench/src/Experiments.hs b/ghcide-bench/src/Experiments.hs index 12ec18a910..10d79ac75f 100644 --- a/ghcide-bench/src/Experiments.hs +++ b/ghcide-bench/src/Experiments.hs @@ -241,7 +241,7 @@ experiments = benchWithSetup "hole fit suggestions" ( mapM_ $ \DocumentPositions{..} -> do - let edit =TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom + let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom .+ #rangeLength .== Nothing .+ #text .== t bottom = Position maxBound 0 @@ -266,6 +266,63 @@ experiments = case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Nothing) of Nothing -> pure True Just _err -> pure False + ), + --------------------------------------------------------------------------------------- + benchWithSetup + "eval execute single-line code lens" + ( mapM_ $ \DocumentPositions{..} -> do + let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom + .+ #rangeLength .== Nothing + .+ #text .== t + bottom = Position maxBound 0 + t = T.unlines + [ "" + , "-- >>> 1 + 2" + ] + changeDoc doc [edit] + ) + ( \docs -> do + not . null <$> forM docs (\DocumentPositions{..} -> do + lenses <- getCodeLenses doc + forM_ lenses $ \case + CodeLens { _command = Just cmd } -> do + executeCommand cmd + waitForProgressStart + waitForProgressDone + _ -> return () + ) + ), + --------------------------------------------------------------------------------------- + benchWithSetup + "eval execute multi-line code lens" + ( mapM_ $ \DocumentPositions{..} -> do + let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom + .+ #rangeLength .== Nothing + .+ #text .== t + bottom = Position maxBound 0 + t = T.unlines + [ "" + , "data T = A | B | C | D" + , " deriving (Show, Eq, Ord, Bounded, Enum)" + , "" + , "{-" + , ">>> import Data.List (nub)" + , ">>> xs = ([minBound..maxBound] ++ [minBound..maxBound] :: [T])" + , ">>> nub xs" + , "-}" + ] + changeDoc doc [edit] + ) + ( \docs -> do + not . null <$> forM docs (\DocumentPositions{..} -> do + lenses <- getCodeLenses doc + forM_ lenses $ \case + CodeLens { _command = Just cmd } -> do + executeCommand cmd + waitForProgressStart + waitForProgressDone + _ -> return () + ) ) ] where hasDefinitions (InL (Definition (InL _))) = True diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index ecadce4d03..f6912c1485 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -277,6 +277,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do . flip xopt_unset LangExt.MonomorphismRestriction . flip gopt_set Opt_ImplicitImportQualified . flip gopt_unset Opt_DiagnosticsShowCaret + . setBackend ghciBackend $ (ms_hspp_opts ms) { useColor = Never , canUseColor = False } diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 4fc251048f..a7f2524f98 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -88,6 +88,7 @@ tests = , 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" + , 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" , goldenWithEval "Reports an error when given with unknown command" "T18" "hs" diff --git a/plugins/hls-eval-plugin/test/testdata/T4139.expected.hs b/plugins/hls-eval-plugin/test/testdata/T4139.expected.hs new file mode 100644 index 0000000000..ade8332a32 --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/T4139.expected.hs @@ -0,0 +1,7 @@ +module T4139 where + +-- >>> 'x' +-- 'x' + +main :: IO () +main = putStrLn "Hello World!" diff --git a/plugins/hls-eval-plugin/test/testdata/T4139.hs b/plugins/hls-eval-plugin/test/testdata/T4139.hs new file mode 100644 index 0000000000..855d6ef08b --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/T4139.hs @@ -0,0 +1,6 @@ +module T4139 where + +-- >>> 'x' + +main :: IO () +main = putStrLn "Hello World!"