Skip to content

Commit 73652d7

Browse files
drsoochdrsooch
authored
Log response errors returned from Plugins (#2988)
* Log ResponseErrors when returned from Plugins * Log from Plugins * Create 'logAndReturnError' that will log any failures in plugins * Missed opportunity to use logAndReturnError * Revert throwPluginError to throwE This reverts a change made previously to try to make pluginErrors have a common error format. This will be updated in the near future. * Warning -> Error * Fix Functional Test for Plugin Response Error * Add orphan instances for * Revert back to Warning * Update log format in test suite
1 parent 510bd51 commit 73652d7

File tree

6 files changed

+109
-78
lines changed

6 files changed

+109
-78
lines changed

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

Lines changed: 52 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module Development.IDE.Plugin.HLS
1010
) where
1111

1212
import Control.Exception (SomeException)
13+
import Control.Lens ((^.))
1314
import Control.Monad
1415
import qualified Data.Aeson as J
1516
import Data.Bifunctor
@@ -21,6 +22,7 @@ import qualified Data.List as List
2122
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
2223
import qualified Data.Map as Map
2324
import Data.String
25+
import Data.Text (Text)
2426
import qualified Data.Text as T
2527
import Development.IDE.Core.Shake hiding (Log)
2628
import Development.IDE.Core.Tracing
@@ -33,9 +35,10 @@ import Ide.Plugin.Config
3335
import Ide.PluginUtils (getClientConfig)
3436
import Ide.Types as HLS
3537
import qualified Language.LSP.Server as LSP
36-
import Language.LSP.VFS
3738
import Language.LSP.Types
3839
import qualified Language.LSP.Types as J
40+
import qualified Language.LSP.Types.Lens as LSP
41+
import Language.LSP.VFS
3942
import Text.Regex.TDFA.Text ()
4043
import UnliftIO (MonadUnliftIO)
4144
import UnliftIO.Async (forConcurrently)
@@ -44,20 +47,48 @@ import UnliftIO.Exception (catchAny)
4447
-- ---------------------------------------------------------------------
4548
--
4649

47-
data Log
48-
= LogNoEnabledPlugins
49-
deriving Show
50+
data Log = LogPluginError ResponseError
51+
deriving Show
5052

5153
instance Pretty Log where
5254
pretty = \case
53-
LogNoEnabledPlugins ->
54-
"extensibleNotificationPlugins no enabled plugins"
55+
LogPluginError err -> prettyResponseError err
56+
57+
-- various error message specific builders
58+
prettyResponseError :: ResponseError -> Doc a
59+
prettyResponseError err = errorCode <> ":" <+> errorBody
60+
where
61+
errorCode = pretty $ show $ err ^. LSP.code
62+
errorBody = pretty $ err ^. LSP.message
63+
64+
pluginNotEnabled :: SMethod m -> [(PluginId, b, a)] -> Text
65+
pluginNotEnabled method availPlugins = "No plugin enabled for " <> T.pack (show method) <> ", available:\n" <> T.pack (unlines $ map (\(plid,_,_) -> show plid) availPlugins)
66+
67+
pluginDoesntExist :: PluginId -> Text
68+
pluginDoesntExist (PluginId pid) = "Plugin " <> pid <> " doesn't exist"
69+
70+
commandDoesntExist :: CommandId -> PluginId -> [PluginCommand ideState] -> Text
71+
commandDoesntExist (CommandId com) (PluginId pid) legalCmds = "Command " <> com <> " isn't defined for plugin " <> pid <> ". Legal commands are:\n" <> T.pack (unlines $ map (show . commandId) legalCmds)
72+
73+
failedToParseArgs :: CommandId -- ^ command that failed to parse
74+
-> PluginId -- ^ Plugin that created the command
75+
-> String -- ^ The JSON Error message
76+
-> J.Value -- ^ The Argument Values
77+
-> Text
78+
failedToParseArgs (CommandId com) (PluginId pid) err arg = "Error while parsing args for " <> com <> " in plugin " <> pid <> ": " <> T.pack err <> "\narg = " <> T.pack (show arg)
79+
80+
-- | Build a ResponseError and log it before returning to the caller
81+
logAndReturnError :: Recorder (WithPriority Log) -> ErrorCode -> Text -> LSP.LspT Config IO (Either ResponseError a)
82+
logAndReturnError recorder errCode msg = do
83+
let err = ResponseError errCode msg Nothing
84+
logWith recorder Warning $ LogPluginError err
85+
pure $ Left err
5586

5687
-- | Map a set of plugins to the underlying ghcide engine.
5788
asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config
5889
asGhcIdePlugin recorder (IdePlugins ls) =
5990
mkPlugin rulesPlugins HLS.pluginRules <>
60-
mkPlugin executeCommandPlugins HLS.pluginCommands <>
91+
mkPlugin (executeCommandPlugins recorder) HLS.pluginCommands <>
6192
mkPlugin (extensiblePlugins recorder) id <>
6293
mkPlugin (extensibleNotificationPlugins recorder) id <>
6394
mkPlugin dynFlagsPlugins HLS.pluginModifyDynflags
@@ -91,11 +122,11 @@ dynFlagsPlugins rs = mempty
91122

92123
-- ---------------------------------------------------------------------
93124

94-
executeCommandPlugins :: [(PluginId, [PluginCommand IdeState])] -> Plugin Config
95-
executeCommandPlugins ecs = mempty { P.pluginHandlers = executeCommandHandlers ecs }
125+
executeCommandPlugins :: Recorder (WithPriority Log) -> [(PluginId, [PluginCommand IdeState])] -> Plugin Config
126+
executeCommandPlugins recorder ecs = mempty { P.pluginHandlers = executeCommandHandlers recorder ecs }
96127

97-
executeCommandHandlers :: [(PluginId, [PluginCommand IdeState])] -> LSP.Handlers (ServerM Config)
98-
executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd
128+
executeCommandHandlers :: Recorder (WithPriority Log) -> [(PluginId, [PluginCommand IdeState])] -> LSP.Handlers (ServerM Config)
129+
executeCommandHandlers recorder ecs = requestHandler SWorkspaceExecuteCommand execCmd
99130
where
100131
pluginMap = Map.fromList ecs
101132

@@ -134,21 +165,15 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd
134165
Just (plugin, cmd) -> runPluginCommand ide plugin cmd cmdParams
135166

136167
-- Couldn't parse the command identifier
137-
_ -> return $ Left $ ResponseError InvalidParams "Invalid command identifier" Nothing
168+
_ -> logAndReturnError recorder InvalidParams "Invalid command Identifier"
138169

139-
runPluginCommand ide p@(PluginId p') com@(CommandId com') arg =
170+
runPluginCommand ide p com arg =
140171
case Map.lookup p pluginMap of
141-
Nothing -> return
142-
(Left $ ResponseError InvalidRequest ("Plugin " <> p' <> " doesn't exist") Nothing)
172+
Nothing -> logAndReturnError recorder InvalidRequest (pluginDoesntExist p)
143173
Just xs -> case List.find ((com ==) . commandId) xs of
144-
Nothing -> return $ Left $
145-
ResponseError InvalidRequest ("Command " <> com' <> " isn't defined for plugin " <> p'
146-
<> ". Legal commands are: " <> T.pack(show $ map commandId xs)) Nothing
174+
Nothing -> logAndReturnError recorder InvalidRequest (commandDoesntExist com p xs)
147175
Just (PluginCommand _ _ f) -> case J.fromJSON arg of
148-
J.Error err -> return $ Left $
149-
ResponseError InvalidParams ("error while parsing args for " <> com' <> " in plugin " <> p'
150-
<> ": " <> T.pack err
151-
<> "\narg = " <> T.pack (show arg)) Nothing
176+
J.Error err -> logAndReturnError recorder InvalidParams (failedToParseArgs com p err arg)
152177
J.Success a -> f ide a
153178

154179
-- ---------------------------------------------------------------------
@@ -169,19 +194,15 @@ extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers }
169194
config <- Ide.PluginUtils.getClientConfig
170195
-- Only run plugins that are allowed to run on this request
171196
let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs'
197+
-- Clients generally don't display ResponseErrors so instead we log any that we come across
172198
case nonEmpty fs of
173-
Nothing -> do
174-
logWith recorder Info LogNoEnabledPlugins
175-
pure $ Left $ ResponseError InvalidRequest
176-
( "No plugin enabled for " <> T.pack (show m)
177-
<> ", available: " <> T.pack (show $ map (\(plid,_,_) -> plid) fs)
178-
)
179-
Nothing
199+
Nothing -> logAndReturnError recorder InvalidRequest (pluginNotEnabled m fs')
180200
Just fs -> do
181201
let msg e pid = "Exception in plugin " <> T.pack (show pid) <> "while processing " <> T.pack (show m) <> ": " <> T.pack (show e)
182202
handlers = fmap (\(plid,_,handler) -> (plid,handler)) fs
183203
es <- runConcurrently msg (show m) handlers ide params
184204
let (errs,succs) = partitionEithers $ toList es
205+
unless (null errs) $ forM_ errs $ \err -> logWith recorder Error $ LogPluginError err
185206
case nonEmpty succs of
186207
Nothing -> pure $ Left $ combineErrors errs
187208
Just xs -> do
@@ -206,9 +227,7 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers
206227
-- Only run plugins that are allowed to run on this request
207228
let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs'
208229
case nonEmpty fs of
209-
Nothing -> do
210-
logWith recorder Info LogNoEnabledPlugins
211-
pure ()
230+
Nothing -> void $ logAndReturnError recorder InvalidRequest (pluginNotEnabled m fs')
212231
Just fs -> do
213232
-- We run the notifications in order, so the core ghcide provider
214233
-- (which restarts the shake process) hopefully comes last
@@ -227,7 +246,7 @@ runConcurrently
227246
-> m (NonEmpty (Either ResponseError d))
228247
runConcurrently msg method fs a b = fmap join $ forConcurrently fs $ \(pid,f) -> otTracedProvider pid (fromString method) $ do
229248
f a b
230-
`catchAny` (\e -> pure $ pure $ Left $ ResponseError InternalError (msg e pid) Nothing)
249+
`catchAny` (\e -> pure $ pure $ Left $ ResponseError InternalError (msg e pid) Nothing)
231250

232251
combineErrors :: [ResponseError] -> ResponseError
233252
combineErrors [x] = x

‎ghcide/src/Development/IDE/Types/Logger.hs

Lines changed: 52 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -29,48 +29,63 @@ module Development.IDE.Types.Logger
2929
, renderStrict
3030
) where
3131

32-
import Control.Concurrent (myThreadId)
33-
import Control.Concurrent.Extra (Lock, newLock, withLock)
34-
import Control.Concurrent.STM (atomically,
35-
newTVarIO, writeTVar, readTVarIO, newTBQueueIO, flushTBQueue, writeTBQueue, isFullTBQueue)
36-
import Control.Exception (IOException)
37-
import Control.Monad (forM_, when, (>=>), unless)
38-
import Control.Monad.IO.Class (MonadIO (liftIO))
39-
import Data.Foldable (for_)
40-
import Data.Functor.Contravariant (Contravariant (contramap))
41-
import Data.Maybe (fromMaybe)
42-
import Data.Text (Text)
43-
import qualified Data.Text as T
44-
import qualified Data.Text as Text
45-
import qualified Data.Text.IO as Text
46-
import Data.Time (defaultTimeLocale, formatTime,
47-
getCurrentTime)
48-
import GHC.Stack (CallStack, HasCallStack,
49-
SrcLoc (SrcLoc, srcLocModule, srcLocStartCol, srcLocStartLine),
50-
callStack, getCallStack,
51-
withFrozenCallStack)
32+
import Control.Concurrent (myThreadId)
33+
import Control.Concurrent.Extra (Lock, newLock, withLock)
34+
import Control.Concurrent.STM (atomically,
35+
flushTBQueue,
36+
isFullTBQueue,
37+
newTBQueueIO, newTVarIO,
38+
readTVarIO,
39+
writeTBQueue, writeTVar)
40+
import Control.Exception (IOException)
41+
import Control.Monad (forM_, unless, when,
42+
(>=>))
43+
import Control.Monad.IO.Class (MonadIO (liftIO))
44+
import Data.Foldable (for_)
45+
import Data.Functor.Contravariant (Contravariant (contramap))
46+
import Data.Maybe (fromMaybe)
47+
import Data.Text (Text)
48+
import qualified Data.Text as T
49+
import qualified Data.Text as Text
50+
import qualified Data.Text.IO as Text
51+
import Data.Time (defaultTimeLocale,
52+
formatTime,
53+
getCurrentTime)
54+
import GHC.Stack (CallStack, HasCallStack,
55+
SrcLoc (SrcLoc, srcLocModule, srcLocStartCol, srcLocStartLine),
56+
callStack, getCallStack,
57+
withFrozenCallStack)
5258
import Language.LSP.Server
53-
import qualified Language.LSP.Server as LSP
54-
import Language.LSP.Types (LogMessageParams (..),
55-
MessageType (..),
56-
SMethod (SWindowLogMessage, SWindowShowMessage),
57-
ShowMessageParams (..))
59+
import qualified Language.LSP.Server as LSP
60+
import Language.LSP.Types (LogMessageParams (..),
61+
MessageType (..),
62+
ResponseError,
63+
SMethod (SWindowLogMessage, SWindowShowMessage),
64+
ShowMessageParams (..))
5865
#if MIN_VERSION_prettyprinter(1,7,0)
59-
import Prettyprinter as PrettyPrinterModule
60-
import Prettyprinter.Render.Text (renderStrict)
66+
import Prettyprinter as PrettyPrinterModule
67+
import Prettyprinter.Render.Text (renderStrict)
6168
#else
62-
import Data.Text.Prettyprint.Doc as PrettyPrinterModule
69+
import Data.Text.Prettyprint.Doc as PrettyPrinterModule
6370
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
6471
#endif
65-
import System.IO (Handle, IOMode (AppendMode),
66-
hClose, hFlush, hSetEncoding,
67-
openFile, stderr, utf8)
68-
import qualified System.Log.Formatter as HSL
69-
import qualified System.Log.Handler as HSL
70-
import qualified System.Log.Handler.Simple as HSL
71-
import qualified System.Log.Logger as HsLogger
72-
import UnliftIO (MonadUnliftIO, displayException,
73-
finally, try)
72+
import Control.Lens ((^.))
73+
import Ide.Types (CommandId (CommandId),
74+
PluginId (PluginId))
75+
import Language.LSP.Types.Lens (HasCode (code),
76+
HasMessage (message))
77+
import System.IO (Handle,
78+
IOMode (AppendMode),
79+
hClose, hFlush,
80+
hSetEncoding, openFile,
81+
stderr, utf8)
82+
import qualified System.Log.Formatter as HSL
83+
import qualified System.Log.Handler as HSL
84+
import qualified System.Log.Handler.Simple as HSL
85+
import qualified System.Log.Logger as HsLogger
86+
import UnliftIO (MonadUnliftIO,
87+
displayException,
88+
finally, try)
7489

7590
data Priority
7691
-- Don't change the ordering of this type or you will mess up the Ord

‎hls-plugin-api/src/Ide/PluginUtils.hs

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -253,10 +253,8 @@ getNormalizedFilePath (PluginId plId) uri = handleMaybe errMsg
253253
errMsg = T.unpack $ "Error(" <> plId <> "): converting " <> getUri uri <> " to NormalizedFilePath"
254254

255255
-- ---------------------------------------------------------------------
256-
throwPluginError :: Monad m => PluginId -> String -> String -> ExceptT String m b
257-
throwPluginError (PluginId who) what where' = throwE msg
258-
where
259-
msg = (T.unpack who) <> " failed with " <> what <> " at " <> where'
256+
throwPluginError :: Monad m => String -> ExceptT String m b
257+
throwPluginError = throwE
260258

261259
handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
262260
handleMaybe msg = maybe (throwE msg) return

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

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,6 @@ codeActionHandler state plId (CodeActionParams _ _ docId currRange _) = pluginRe
9797
literalPairs = map (\lit -> (lit, alternateFormat lit)) litsInRange
9898
-- make a code action for every literal and its' alternates (then flatten the result)
9999
actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit enabledExtensions pragma) alts) literalPairs
100-
101100
pure $ List actions
102101
where
103102
inCurrentRange :: Literal -> Bool

‎plugins/hls-call-hierarchy-plugin/src/Ide/Plugin/CallHierarchy/Internal.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -203,7 +203,7 @@ incomingCalls state pluginId param = pluginResponse $ do
203203
mergeIncomingCalls
204204
case calls of
205205
Just x -> pure $ Just $ List x
206-
Nothing -> throwPluginError callHierarchyId "Internal Error" "incomingCalls"
206+
Nothing -> throwPluginError "incomingCalls - Internal Error"
207207
where
208208
mkCallHierarchyIncomingCall :: Vertex -> Action (Maybe CallHierarchyIncomingCall)
209209
mkCallHierarchyIncomingCall = mkCallHierarchyCall CallHierarchyIncomingCall
@@ -224,7 +224,7 @@ outgoingCalls state pluginId param = pluginResponse $ do
224224
mergeOutgoingCalls
225225
case calls of
226226
Just x -> pure $ Just $ List x
227-
Nothing -> throwPluginError callHierarchyId "Internal Error" "outgoingCalls"
227+
Nothing -> throwPluginError "outgoingCalls - Internal Error"
228228
where
229229
mkCallHierarchyOutgoingCall :: Vertex -> Action (Maybe CallHierarchyOutgoingCall)
230230
mkCallHierarchyOutgoingCall = mkCallHierarchyCall CallHierarchyOutgoingCall

‎test/functional/Format.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ providerTests = testGroup "formatting provider" [
4747
testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do
4848
doc <- openDoc "Format.hs" "haskell"
4949
resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)
50-
liftIO $ resp ^. LSP.result @?= Left (ResponseError InvalidRequest "No plugin enabled for STextDocumentFormatting, available: []" Nothing)
50+
liftIO $ resp ^. LSP.result @?= Left (ResponseError InvalidRequest "No plugin enabled for STextDocumentFormatting, available:\nPluginId \"floskell\"\nPluginId \"fourmolu\"\nPluginId \"ormolu\"\nPluginId \"stylish-haskell\"\nPluginId \"brittany\"\n" Nothing)
5151

5252
, requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do
5353
formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs"

0 commit comments

Comments
 (0)