Skip to content

Commit dca5cc3

Browse files
pepeiborrapepeiborra
authored
Log plugin name and attribute errors to plugins (#3194)
* Log plugin name * redundant import * Attribute response error logs to plugins * remove redundant plugin names from error messages * improve pretty printing * Avoid show * simplify test messages * Fix
1 parent b547d4e commit dca5cc3

File tree

12 files changed

+88
-73
lines changed

12 files changed

+88
-73
lines changed

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,6 @@ import System.IO (BufferMode (LineBuffe
143143
import System.Random (newStdGen)
144144
import System.Time.Extra (Seconds, offsetTime,
145145
showDuration)
146-
import Text.Printf (printf)
147146

148147
data Log
149148
= LogHeapStats !HeapStats.Log

‎ghcide/src/Development/IDE/Plugin/HLS.hs

Lines changed: 37 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -13,13 +13,16 @@ import Control.Exception (SomeException)
1313
import Control.Lens ((^.))
1414
import Control.Monad
1515
import qualified Data.Aeson as J
16+
import Data.Bifunctor (first)
1617
import Data.Dependent.Map (DMap)
1718
import qualified Data.Dependent.Map as DMap
1819
import Data.Dependent.Sum
1920
import Data.Either
2021
import qualified Data.List as List
2122
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
23+
import qualified Data.List.NonEmpty as NE
2224
import qualified Data.Map as Map
25+
import Data.Some
2326
import Data.String
2427
import Data.Text (Text)
2528
import qualified Data.Text as T
@@ -38,6 +41,7 @@ import Language.LSP.Types
3841
import qualified Language.LSP.Types as J
3942
import qualified Language.LSP.Types.Lens as LSP
4043
import Language.LSP.VFS
44+
import Prettyprinter.Render.String (renderString)
4145
import Text.Regex.TDFA.Text ()
4246
import UnliftIO (MonadUnliftIO)
4347
import UnliftIO.Async (forConcurrently)
@@ -46,12 +50,18 @@ import UnliftIO.Exception (catchAny)
4650
-- ---------------------------------------------------------------------
4751
--
4852

49-
data Log = LogPluginError ResponseError
50-
deriving Show
51-
53+
data Log
54+
= LogPluginError PluginId ResponseError
55+
| LogNoPluginForMethod (Some SMethod)
56+
| LogInvalidCommandIdentifier
5257
instance Pretty Log where
5358
pretty = \case
54-
LogPluginError err -> prettyResponseError err
59+
LogPluginError (PluginId pId) err -> pretty pId <> ":" <+> prettyResponseError err
60+
LogNoPluginForMethod (Some method) ->
61+
"No plugin enabled for " <> pretty (show method)
62+
LogInvalidCommandIdentifier-> "Invalid command identifier"
63+
64+
instance Show Log where show = renderString . layoutCompact . pretty
5565

5666
-- various error message specific builders
5767
prettyResponseError :: ResponseError -> Doc a
@@ -77,10 +87,10 @@ failedToParseArgs :: CommandId -- ^ command that failed to parse
7787
failedToParseArgs (CommandId com) (PluginId pid) err arg = "Error while parsing args for " <> com <> " in plugin " <> pid <> ": " <> T.pack err <> "\narg = " <> T.pack (show arg)
7888

7989
-- | Build a ResponseError and log it before returning to the caller
80-
logAndReturnError :: Recorder (WithPriority Log) -> ErrorCode -> Text -> LSP.LspT Config IO (Either ResponseError a)
81-
logAndReturnError recorder errCode msg = do
90+
logAndReturnError :: Recorder (WithPriority Log) -> PluginId -> ErrorCode -> Text -> LSP.LspT Config IO (Either ResponseError a)
91+
logAndReturnError recorder p errCode msg = do
8292
let err = ResponseError errCode msg Nothing
83-
logWith recorder Warning $ LogPluginError err
93+
logWith recorder Warning $ LogPluginError p err
8494
pure $ Left err
8595

8696
-- | Map a set of plugins to the underlying ghcide engine.
@@ -164,15 +174,17 @@ executeCommandHandlers recorder ecs = requestHandler SWorkspaceExecuteCommand ex
164174
Just (plugin, cmd) -> runPluginCommand ide plugin cmd cmdParams
165175

166176
-- Couldn't parse the command identifier
167-
_ -> logAndReturnError recorder InvalidParams "Invalid command Identifier"
177+
_ -> do
178+
logWith recorder Warning LogInvalidCommandIdentifier
179+
return $ Left $ ResponseError InvalidParams "Invalid command identifier" Nothing
168180

169181
runPluginCommand ide p com arg =
170182
case Map.lookup p pluginMap of
171-
Nothing -> logAndReturnError recorder InvalidRequest (pluginDoesntExist p)
183+
Nothing -> logAndReturnError recorder p InvalidRequest (pluginDoesntExist p)
172184
Just xs -> case List.find ((com ==) . commandId) xs of
173-
Nothing -> logAndReturnError recorder InvalidRequest (commandDoesntExist com p xs)
185+
Nothing -> logAndReturnError recorder p InvalidRequest (commandDoesntExist com p xs)
174186
Just (PluginCommand _ _ f) -> case J.fromJSON arg of
175-
J.Error err -> logAndReturnError recorder InvalidParams (failedToParseArgs com p err arg)
187+
J.Error err -> logAndReturnError recorder p InvalidParams (failedToParseArgs com p err arg)
176188
J.Success a -> f ide a
177189

178190
-- ---------------------------------------------------------------------
@@ -195,15 +207,21 @@ extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers }
195207
let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs'
196208
-- Clients generally don't display ResponseErrors so instead we log any that we come across
197209
case nonEmpty fs of
198-
Nothing -> logAndReturnError recorder InvalidRequest (pluginNotEnabled m fs')
210+
Nothing -> do
211+
logWith recorder Warning (LogNoPluginForMethod $ Some m)
212+
let err = ResponseError InvalidRequest msg Nothing
213+
msg = pluginNotEnabled m fs'
214+
return $ Left err
199215
Just fs -> do
200216
let msg e pid = "Exception in plugin " <> T.pack (show pid) <> " while processing " <> T.pack (show m) <> ": " <> T.pack (show e)
201217
handlers = fmap (\(plid,_,handler) -> (plid,handler)) fs
202218
es <- runConcurrently msg (show m) handlers ide params
203-
let (errs,succs) = partitionEithers $ toList es
204-
unless (null errs) $ forM_ errs $ \err -> logWith recorder Warning $ LogPluginError err
219+
220+
let (errs,succs) = partitionEithers $ toList $ join $ NE.zipWith (\(pId,_) -> fmap (first (pId,))) handlers es
221+
unless (null errs) $ forM_ errs $ \(pId, err) ->
222+
logWith recorder Warning $ LogPluginError pId err
205223
case nonEmpty succs of
206-
Nothing -> pure $ Left $ combineErrors errs
224+
Nothing -> pure $ Left $ combineErrors $ map snd errs
207225
Just xs -> do
208226
caps <- LSP.getClientCapabilities
209227
pure $ Right $ combineResponses m config caps params xs
@@ -226,7 +244,8 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers
226244
-- Only run plugins that are allowed to run on this request
227245
let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs'
228246
case nonEmpty fs of
229-
Nothing -> void $ logAndReturnError recorder InvalidRequest (pluginNotEnabled m fs')
247+
Nothing -> do
248+
logWith recorder Warning (LogNoPluginForMethod $ Some m)
230249
Just fs -> do
231250
-- We run the notifications in order, so the core ghcide provider
232251
-- (which restarts the shake process) hopefully comes last
@@ -242,8 +261,8 @@ runConcurrently
242261
-- ^ Enabled plugin actions that we are allowed to run
243262
-> a
244263
-> b
245-
-> m (NonEmpty (Either ResponseError d))
246-
runConcurrently msg method fs a b = fmap join $ forConcurrently fs $ \(pid,f) -> otTracedProvider pid (fromString method) $ do
264+
-> m (NonEmpty(NonEmpty (Either ResponseError d)))
265+
runConcurrently msg method fs a b = forConcurrently fs $ \(pid,f) -> otTracedProvider pid (fromString method) $ do
247266
f a b
248267
`catchAny` (\e -> pure $ pure $ Left $ ResponseError InternalError (msg e pid) Nothing)
249268

‎haskell-language-server.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -523,6 +523,7 @@ test-suite func-test
523523
, lens
524524
, lens-aeson
525525
, ghcide
526+
, ghcide-test-utils
526527
, hls-test-utils ^>=1.4
527528
, lsp-types
528529
, aeson

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

Lines changed: 13 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,7 @@ module Ide.Plugin.AlternateNumberFormat (descriptor, Log(..)) where
88
import Control.Lens ((^.))
99
import Control.Monad.Except (ExceptT, MonadIO, liftIO)
1010
import qualified Data.HashMap.Strict as HashMap
11-
import Data.String (IsString)
12-
import Data.Text (Text)
11+
import Data.Text (Text, unpack)
1312
import qualified Data.Text as T
1413
import Development.IDE (GetParsedModule (GetParsedModule),
1514
GhcSession (GhcSession),
@@ -43,11 +42,8 @@ instance Pretty Log where
4342
pretty = \case
4443
LogShake log -> pretty log
4544

46-
alternateNumberFormatId :: IsString a => a
47-
alternateNumberFormatId = "alternateNumberFormat"
48-
49-
descriptor :: Recorder (WithPriority Log) -> PluginDescriptor IdeState
50-
descriptor recorder = (defaultPluginDescriptor alternateNumberFormatId)
45+
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
46+
descriptor recorder pId = (defaultPluginDescriptor pId)
5147
{ pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionHandler
5248
, pluginRules = collectLiteralsRule recorder
5349
}
@@ -87,10 +83,10 @@ collectLiteralsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collec
8783
getExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary
8884

8985
codeActionHandler :: PluginMethodHandler IdeState 'TextDocumentCodeAction
90-
codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = pluginResponse $ do
86+
codeActionHandler state pId (CodeActionParams _ _ docId currRange _) = pluginResponse $ do
9187
nfp <- getNormalizedFilePath (docId ^. L.uri)
92-
CLR{..} <- requestLiterals state nfp
93-
pragma <- getFirstPragma state nfp
88+
CLR{..} <- requestLiterals pId state nfp
89+
pragma <- getFirstPragma pId state nfp
9490
-- remove any invalid literals (see validTarget comment)
9591
let litsInRange = filter inCurrentRange literals
9692
-- generate alternateFormats and zip with the literal that generated the alternates
@@ -145,16 +141,16 @@ contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSr
145141
isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
146142
p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p && p <= ep
147143

148-
getFirstPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
149-
getFirstPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ do
150-
ghcSession <- liftIO $ runAction (alternateNumberFormatId <> ".GhcSession") state $ useWithStale GhcSession nfp
151-
(_, fileContents) <- liftIO $ runAction (alternateNumberFormatId <> ".GetFileContents") state $ getFileContents nfp
144+
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
145+
getFirstPragma (PluginId pId) state nfp = handleMaybeM "Could not get NextPragmaInfo" $ do
146+
ghcSession <- liftIO $ runAction (unpack pId <> ".GhcSession") state $ useWithStale GhcSession nfp
147+
(_, fileContents) <- liftIO $ runAction (unpack pId <> ".GetFileContents") state $ getFileContents nfp
152148
case ghcSession of
153149
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
154150
Nothing -> pure Nothing
155151

156-
requestLiterals :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
157-
requestLiterals state = handleMaybeM "Error: Could not Collect Literals"
152+
requestLiterals :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m CollectLiteralsResult
153+
requestLiterals (PluginId pId) state = handleMaybeM "Could not Collect Literals"
158154
. liftIO
159-
. runAction (alternateNumberFormatId <> ".CollectLiterals") state
155+
. runAction (unpack pId <> ".CollectLiterals") state
160156
. use CollectLiterals

‎plugins/hls-alternate-number-format-plugin/test/Main.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ main :: IO ()
2020
main = defaultTestRunner test
2121

2222
alternateNumberFormatPlugin :: PluginDescriptor IdeState
23-
alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty
23+
alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty "alternateNumberFormat"
2424

2525
-- NOTE: For whatever reason, this plugin does not play nice with creating Code Actions on time.
2626
-- As a result tests will mostly pass if `import Prelude` is added at the top. We (mostly fendor) surmise this has something

‎plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ codeActionHandler ideState _ CodeActionParams {_textDocument = TextDocumentIdent
4545
pure $ List actions
4646

4747
getDecls :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m [LHsDecl GhcPs]
48-
getDecls state = handleMaybeM "Error: Could not get Parsed Module"
48+
getDecls state = handleMaybeM "Could not get Parsed Module"
4949
. liftIO
5050
. fmap (fmap (hsmodDecls . unLoc . pm_parsed_source))
5151
. runAction (changeTypeSignatureId <> ".GetParsedModule") state

‎plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -190,7 +190,7 @@ codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginRe
190190
. liftIO
191191
. runAction "classplugin.findClassFromIdentifier.TypeCheck" state
192192
$ useWithStale TypeCheck docPath
193-
handleMaybeM "Error in TcEnv"
193+
handleMaybeM "TcEnv"
194194
. liftIO
195195
. fmap snd
196196
. initTcWithGbl hscenv thisMod ghostSpan $ do

‎plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -36,11 +36,8 @@ import Ide.PluginUtils (getNormalizedFilePath,
3636
import Ide.Types hiding (pluginId)
3737
import Language.LSP.Types
3838

39-
pluginId :: PluginId
40-
pluginId = "explicitFixity"
41-
42-
descriptor :: Recorder (WithPriority Log) -> PluginDescriptor IdeState
43-
descriptor recorder = (defaultPluginDescriptor pluginId)
39+
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
40+
descriptor recorder pluginId = (defaultPluginDescriptor pluginId)
4441
{ pluginRules = fixityRule recorder
4542
, pluginHandlers = mkPluginHandler STextDocumentHover hover
4643
-- Make this plugin has a lower priority than ghcide's plugin to ensure
@@ -51,7 +48,7 @@ descriptor recorder = (defaultPluginDescriptor pluginId)
5148
hover :: PluginMethodHandler IdeState TextDocumentHover
5249
hover state _ (HoverParams (TextDocumentIdentifier uri) pos _) = pluginResponse $ do
5350
nfp <- getNormalizedFilePath uri
54-
fixityTrees <- handleMaybeM "ExplicitFixity: Unable to get fixity"
51+
fixityTrees <- handleMaybeM "Unable to get fixity"
5552
$ liftIO
5653
$ runAction "ExplicitFixity.GetFixity" state
5754
$ use GetFixity nfp

‎plugins/hls-explicit-fixity-plugin/test/Main.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import System.FilePath
88
import Test.Hls
99

1010
plugin :: PluginDescriptor IdeState
11-
plugin = descriptor mempty
11+
plugin = descriptor mempty "explicit-fixity"
1212

1313
main :: IO ()
1414
main = defaultTestRunner tests

‎plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ import qualified Data.Text as T
3333
import Development.IDE (GetParsedModule (GetParsedModule),
3434
GhcSession (GhcSession),
3535
IdeState, Pretty,
36-
Priority (Debug, Info), Recorder,
36+
Priority (Debug), Recorder,
3737
WithPriority, colon, evalGhcEnv,
3838
hscEnvWithImportPaths, logWith,
3939
realSrcSpanToRange, runAction,
@@ -112,7 +112,7 @@ action recorder state uri =
112112
correctNames <- liftIO $ pathModuleNames recorder state nfp fp
113113
logWith recorder Debug (CorrectNames correctNames)
114114
bestName <- minimumBy (comparing T.length) <$> (MaybeT . pure $ NE.nonEmpty correctNames)
115-
logWith recorder Info (BestName bestName)
115+
logWith recorder Debug (BestName bestName)
116116

117117
statedNameMaybe <- liftIO $ codeModuleName state nfp
118118
logWith recorder Debug (ModuleName $ snd <$> statedNameMaybe)

0 commit comments

Comments
 (0)