ghcide-bench 2.7.0.0 → 2.8.0.0
raw patch · 2 files changed
+97/−20 lines, 2 files
Files
- ghcide-bench.cabal +1/−2
- src/Experiments.hs +96/−18
ghcide-bench.cabal view
@@ -2,7 +2,7 @@ build-type: Simple category: Development name: ghcide-bench-version: 2.7.0.0+version: 2.8.0.0 license: Apache-2.0 license-file: LICENSE author: The Haskell IDE team@@ -89,7 +89,6 @@ default-language: GHC2021 build-tool-depends: ghcide:ghcide,- implicit-hie:gen-hie main-is: Main.hs hs-source-dirs: test ghc-options: -Wunused-packages
src/Experiments.hs view
@@ -26,7 +26,8 @@ import Control.Concurrent.Async (withAsync) import Control.Exception.Safe (IOException, handleAny, try)-import Control.Lens (_Just, (&), (.~), (^.))+import Control.Lens (_Just, (&), (.~), (^.),+ (^?)) import Control.Lens.Extras (is) import Control.Monad.Extra (allM, forM, forM_, forever, unless, void, when,@@ -48,8 +49,7 @@ import Data.Version import Development.IDE.Plugin.Test import Development.IDE.Test.Diagnostic-import Development.Shake (CmdOption (Cwd, FileStdout),- cmd_)+import Development.Shake (CmdOption (Cwd), cmd_) import Experiments.Types import Language.LSP.Protocol.Capabilities import qualified Language.LSP.Protocol.Lens as L@@ -100,7 +100,19 @@ experiments :: HasConfig => [Bench] experiments =- [ ---------------------------------------------------------------------------------------+ [+ bench "semanticTokens" $ \docs -> do+ liftIO $ putStrLn "Starting semanticTokens"+ r <- forM docs $ \DocumentPositions{..} -> do+ changeDoc doc [charEdit stringLiteralP]+ waitForProgressStart+ waitForProgressDone+ tks <- getSemanticTokens doc+ case tks ^? LSP._L of+ Just _ -> return True+ Nothing -> return False+ return $ and r,+ --------------------------------------------------------------------------------------- bench "hover" $ allWithIdentifierPos $ \DocumentPositions{..} -> isJust <$> getHover doc (fromJust identifierP), ---------------------------------------------------------------------------------------@@ -115,7 +127,7 @@ (\docs -> do hieYamlUri <- getDocUri "hie.yaml" liftIO $ appendFile (fromJust $ uriToFilePath hieYamlUri) "##\n"- sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $+ sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams [ FileEvent hieYamlUri FileChangeType_Changed ] flip allWithIdentifierPos docs $ \DocumentPositions{..} -> isJust <$> getHover doc (fromJust identifierP) ),@@ -197,7 +209,7 @@ ( \docs -> do hieYamlUri <- getDocUri "hie.yaml" liftIO $ appendFile (fromJust $ uriToFilePath hieYamlUri) "##\n"- sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $+ sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams [ FileEvent hieYamlUri FileChangeType_Changed ] waitForProgressStart waitForProgressStart@@ -228,7 +240,7 @@ 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@@ -253,7 +265,64 @@ 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 hasDefinitions (InL (Definition (InR ls))) = not $ null ls@@ -316,7 +385,7 @@ extract parses = listToMaybe [ res | (res,"") <- parses] output :: (MonadIO m, HasConfig) => String -> m ()-output = if quiet?config then (\_ -> pure ()) else liftIO . putStrLn+output = if quiet ?config then (\_ -> pure ()) else liftIO . putStrLn --------------------------------------------------------------------------------------- @@ -594,15 +663,25 @@ output cmd callCommand cmd +simpleCabalCradleContent :: String+simpleCabalCradleContent = "cradle:\n cabal:\n"++simpleStackCradleContent :: String+simpleStackCradleContent = "cradle:\n stack:\n"++-- | Setup the benchmark+-- we need to create a hie.yaml file for the examples+-- or the hie.yaml file would be searched in the parent directories recursively+-- implicit-hie is error prone for the example test `lsp-types-2.1.1.0`+-- we are using the simpleCabalCradleContent for the hie.yaml file instead.+-- it works if we have cabal > 3.2. setup :: HasConfig => IO SetupResult setup = do--- when alreadyExists $ removeDirectoryRecursive examplesPath benchDir <- case exampleDetails(example ?config) of ExamplePath examplePath -> do let hieYamlPath = examplePath </> "hie.yaml" alreadyExists <- doesFileExist hieYamlPath- unless alreadyExists $- cmd_ (Cwd examplePath) (FileStdout hieYamlPath) ("gen-hie"::String)+ unless alreadyExists $ writeFile hieYamlPath simpleCabalCradleContent return examplePath ExampleScript examplePath' scriptArgs -> do let exampleDir = examplesPath </> exampleName (example ?config)@@ -613,8 +692,8 @@ cmd_ (Cwd exampleDir) examplePath scriptArgs let hieYamlPath = exampleDir </> "hie.yaml" alreadyExists <- doesFileExist hieYamlPath- unless alreadyExists $- cmd_ (Cwd exampleDir) (FileStdout hieYamlPath) ("gen-hie"::String)+ unless alreadyExists $ writeFile hieYamlPath simpleCabalCradleContent+ return exampleDir ExampleHackage ExamplePackage{..} -> do let path = examplesPath </> package@@ -627,7 +706,7 @@ let cabalVerbosity = "-v" ++ show (fromEnum (verbose ?config)) callCommandLogging $ "cabal get " <> cabalVerbosity <> " " <> package <> " -d " <> examplesPath let hieYamlPath = path </> "hie.yaml"- cmd_ (Cwd path) (FileStdout hieYamlPath) ("gen-hie"::String)+ writeFile hieYamlPath simpleCabalCradleContent -- Need this in case there is a parent cabal.project somewhere writeFile (path </> "cabal.project")@@ -655,13 +734,12 @@ ,"compiler"] ] )-- cmd_ (Cwd path) (FileStdout hieYamlPath) ("gen-hie"::String) ["--stack"::String]+ writeFile hieYamlPath simpleStackCradleContent return path whenJust (shakeProfiling ?config) $ createDirectoryIfMissing True - let cleanUp = case exampleDetails(example ?config) of+ let cleanUp = case exampleDetails (example ?config) of ExampleHackage _ -> removeDirectoryRecursive examplesPath ExampleScript _ _ -> removeDirectoryRecursive examplesPath ExamplePath _ -> return ()@@ -698,7 +776,7 @@ findEndOfImports :: [DocumentSymbol] -> Maybe Position findEndOfImports (DocumentSymbol{_kind = SymbolKind_Module, _name = "imports", _range} : _) = Just $ Position (succ $ _line $ _end _range) 4-findEndOfImports [DocumentSymbol{_kind = SymbolKind_File, _children = Just (cc)}] =+findEndOfImports [DocumentSymbol{_kind = SymbolKind_File, _children = Just cc}] = findEndOfImports cc findEndOfImports (DocumentSymbol{_range} : _) = Just $ _range ^. L.start