Skip to content

Speed up hls-hlint-plugin-tests #4144

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 1 commit into from
Closed

Speed up hls-hlint-plugin-tests #4144

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions ghcide/src/Development/IDE/Core/OfInterest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@ import Ide.Logger (Pretty (pretty),
logDebug)
import qualified Language.LSP.Protocol.Message as LSP
import qualified Language.LSP.Server as LSP
import qualified Data.Aeson as Aeson

data Log = LogShake Shake.Log
deriving Show
Expand Down
13 changes: 6 additions & 7 deletions ghcide/src/Development/IDE/Core/Shake.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1281,29 +1281,28 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
let uri' = filePathToUri' fp
let delay = if null newDiags then 0.1 else 0
registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
join $ mask_ $ do
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
let action = when (lastPublish /= newDiags) $ case lspEnv of
join $ mask_ $ do
lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
let action = when (lastPublish /= newDiags) $ case lspEnv of
Nothing -> -- Print an LSP event.
logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (fp, ShowDiag,) newDiags)
Just env -> LSP.runLspT env $ do
liftIO $ tag "count" (show $ Prelude.length newDiags)
liftIO $ tag "key" (show k)
LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $
LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) newDiags
return action
return action
where
diagsFromRule :: Diagnostic -> Diagnostic
diagsFromRule c@Diagnostic{_range}
| coerce ideTesting = c & L.relatedInformation ?~
[
DiagnosticRelatedInformation
[ DiagnosticRelatedInformation
(Location
(filePathToUri $ fromNormalizedFilePath fp)
_range
)
(T.pack $ show k)
]
]
| otherwise = c


Expand Down
2 changes: 2 additions & 0 deletions haskell-language-server.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -691,6 +691,8 @@ library hls-hlint-plugin
, unordered-containers
, ghc-lib-parser-ex
, apply-refact
--
, lsp-types

if flag(ghc-lib)
cpp-options: -DGHC_LIB
Expand Down
24 changes: 24 additions & 0 deletions hls-test-utils/src/Test/Hls.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.Hls
( module Test.Tasty.HUnit,
module Test.Tasty,
Expand Down Expand Up @@ -57,6 +58,7 @@ module Test.Hls
WithPriority(..),
Recorder,
Priority(..),
captureKickDiagnostics,
)
where

Expand Down Expand Up @@ -124,6 +126,9 @@ import Test.Tasty.ExpectedFailure
import Test.Tasty.Golden
import Test.Tasty.HUnit
import Test.Tasty.Ingredients.Rerun
import Language.LSP.Protocol.Lens qualified as L
import Data.Maybe (mapMaybe)
import Control.Lens ((^.))

data Log
= LogIDEMain IDEMain.Log
Expand Down Expand Up @@ -712,6 +717,17 @@ setHlsConfig config = do
-- requests!
skipManyTill anyMessage (void configurationRequest)

captureKickDiagnostics :: Session [Diagnostic]
captureKickDiagnostics = do
_ <- skipManyTill anyMessage nonTrivialKickStart2
messages <- manyTill anyMessage nonTrivialKickDone2
Copy link
Collaborator

@soulomoon soulomoon Apr 6, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Would it work if we are using the combination of nonTrivialKickDone and nonTrivialKickDone?

Copy link
Collaborator Author

@fendor fendor Apr 6, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Pardon, I think you wrote the same function twice 😃

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sorry, one of them is nonTrivialKickStart. But never mind, I think it won't work anyway.
To make sure it works we would have to customize a signal for every rule. But It should only turned on if we enable it(Provide a switch as we did for ideTesting🤔), otherwise there would be too many rules being logged.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We don't even need to change the method name, we could put the information about what rule it was in the method parameters.

Or we could just use $/logTrace, which we don't use at all at the moment and is maybe quite suited to this?

pure $ concat $ mapMaybe diagnostics messages
where
diagnostics :: FromServerMessage' a -> Maybe [Diagnostic]
diagnostics = \msg -> case msg of
FromServerMess SMethod_TextDocumentPublishDiagnostics diags -> Just (diags ^. L.params . L.diagnostics)
_ -> Nothing

waitForKickDone :: Session ()
waitForKickDone = void $ skipManyTill anyMessage nonTrivialKickDone

Expand All @@ -724,9 +740,17 @@ nonTrivialKickDone = kick (Proxy @"kick/done") >>= guard . not . null
nonTrivialKickStart :: Session ()
nonTrivialKickStart = kick (Proxy @"kick/start") >>= guard . not . null

nonTrivialKickDone2 :: Session ()
nonTrivialKickDone2 = kick (Proxy @"kick/done/hlint") >>= guard . not . null

nonTrivialKickStart2 :: Session ()
nonTrivialKickStart2 = kick (Proxy @"kick/start/hlint") >>= guard . not . null


kick :: KnownSymbol k => Proxy k -> Session [FilePath]
kick proxyMsg = do
NotMess TNotificationMessage{_params} <- customNotification proxyMsg
case fromJSON _params of
Success x -> return x
other -> error $ "Failed to parse kick/done details: " <> show other

31 changes: 22 additions & 9 deletions plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,11 @@ import System.Environment (setEnv,
#endif
import Development.IDE.Core.PluginUtils as PluginUtils
import Text.Regex.TDFA.Text ()
import qualified Language.LSP.Protocol.Message as LSP
import qualified Language.LSP.Server as LSP
import GHC.TypeLits (KnownSymbol)
import qualified Development.IDE.Types.Options as Options

-- ---------------------------------------------------------------------

data Log
Expand All @@ -140,7 +145,7 @@ instance Pretty Log where
LogShake log -> pretty log
LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res
LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas
LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <+> pretty exts
LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <> line <> indent 4 (pretty exts)
LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp
LogResolve msg -> pretty msg

Expand Down Expand Up @@ -189,12 +194,12 @@ instance NFData GetHlintDiagnostics
type instance RuleResult GetHlintDiagnostics = ()

-- | Hlint rules to generate file diagnostics based on hlint hints
-- | This rule is recomputed when:
-- | - A file has been edited via
-- | - `getIdeas` -> `getParsedModule` in any case
-- | - `getIdeas` -> `getFileContents` if the hls ghc does not match the hlint default ghc
-- | - The client settings have changed, to honour the `hlintOn` setting, via `getClientConfigAction`
-- | - The hlint specific settings have changed, via `getHlintSettingsRule`
-- This rule is recomputed when:
-- - A file has been edited via
-- - `getIdeas` -> `getParsedModule` in any case
-- - `getIdeas` -> `getFileContents` if the hls ghc does not match the hlint default ghc
-- - The client settings have changed, to honour the `hlintOn` setting, via `getClientConfigAction`
-- - The hlint specific settings have changed, via `getHlintSettingsRule`
rules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
rules recorder plugin = do
define (cmapWithPrio LogShake recorder) $ \GetHlintDiagnostics file -> do
Expand All @@ -208,8 +213,16 @@ rules recorder plugin = do
liftIO $ argsSettings flags

action $ do
files <- getFilesOfInterestUntracked
void $ uses GetHlintDiagnostics $ Map.keys files
files <- Map.keys <$> getFilesOfInterestUntracked
Shake.ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- Shake.getShakeExtras
let signal :: KnownSymbol s => Proxy s -> Action ()
signal msg = when testing $ liftIO $ Shake.mRunLspT lspEnv $
LSP.sendNotification (LSP.SMethod_CustomMethod msg) $
toJSON $ map fromNormalizedFilePath files

signal (Proxy @"kick/start/hlint")
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we do this generically? Like, for every rule, send custom method notifications for starting and finishing? It seems like many (most?) tests want this sort of thing, just having a generic signal when rules start or finish would be quite handy.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think only diagnostic tests need it, but yeah, we can definitely generalise it.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I support it, since we are already tracing the action any way, see otTracedAction.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We could add a log handler that intercepts rule start/finish logs and sends the custom messages, like we do for sending window/logMessage etc.

void $ uses GetHlintDiagnostics files
signal (Proxy @"kick/done/hlint")

where

Expand Down
Loading