-
-
Notifications
You must be signed in to change notification settings - Fork 391
Draft: Introduce hierarchical error types and error handling for plugins #3659
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.
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
Changes from all commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,108 @@ | ||
{-# LANGUAGE GADTs #-} | ||
module Development.IDE.Core.PluginUtils where | ||
|
||
import Control.Monad.Extra | ||
import Control.Monad.IO.Class | ||
import Control.Monad.Reader (runReaderT) | ||
import Control.Monad.Trans.Except | ||
import Control.Monad.Trans.Maybe | ||
import Data.Either.Extra (maybeToEither) | ||
import Data.Functor.Identity | ||
import qualified Data.Text as T | ||
import Development.IDE.Core.PositionMapping | ||
import Development.IDE.Core.Shake (IdeAction, IdeRule, | ||
IdeState (shakeExtras), | ||
mkDelayedAction, | ||
shakeEnqueue) | ||
import qualified Development.IDE.Core.Shake as Shake | ||
import Development.IDE.GHC.Orphans () | ||
import Development.IDE.Graph hiding (ShakeValue) | ||
import Development.IDE.Types.Location (NormalizedFilePath) | ||
import qualified Development.IDE.Types.Location as Location | ||
import qualified Development.IDE.Types.Logger as Logger | ||
import qualified Ide.PluginUtils as PluginUtils | ||
import qualified Language.LSP.Types as LSP | ||
import Prettyprinter | ||
import Prettyprinter.Render.Text (renderStrict) | ||
|
||
-- ---------------------------------------------------------------------------- | ||
-- Plugin Error wrapping | ||
-- ---------------------------------------------------------------------------- | ||
|
||
data GhcidePluginError | ||
= forall a . Show a => FastRuleNotReady a | ||
| forall a . Show a => RuleFailed a | ||
| CoreError PluginUtils.PluginError | ||
|
||
instance Pretty GhcidePluginError where | ||
pretty = \case | ||
FastRuleNotReady rule -> "FastRuleNotReady:" <+> viaShow rule | ||
RuleFailed rule -> "RuleFailed:" <+> viaShow rule | ||
CoreError perror -> pretty $ PluginUtils.prettyPluginError perror | ||
|
||
pluginResponse :: | ||
Monad m => | ||
ExceptT GhcidePluginError m a -> | ||
m (Either LSP.ResponseError a) | ||
pluginResponse = PluginUtils.pluginResponse' handlePluginError | ||
|
||
withPluginError :: Functor m => ExceptT PluginUtils.PluginError m a -> ExceptT GhcidePluginError m a | ||
withPluginError = PluginUtils.withError CoreError | ||
|
||
mkPluginErrorMessage :: T.Text -> GhcidePluginError | ||
mkPluginErrorMessage = CoreError . PluginUtils.mkPluginErrorMessage | ||
|
||
handlePluginError :: GhcidePluginError -> LSP.ResponseError | ||
handlePluginError msg = PluginUtils.mkSimpleResponseError $ renderStrict simpleDoc | ||
where | ||
simpleDoc = layoutPretty defaultLayoutOptions $ pretty msg | ||
|
||
-- ---------------------------------------------------------------------------- | ||
-- Action wrappers | ||
-- ---------------------------------------------------------------------------- | ||
|
||
runAction :: MonadIO m => String -> IdeState -> ExceptT e Action a -> ExceptT e m a | ||
runAction herald ide act = | ||
PluginUtils.hoistExceptT . ExceptT $ | ||
join $ shakeEnqueue (shakeExtras ide) (mkDelayedAction herald Logger.Debug $ runExceptT act) | ||
|
||
-- | Request a Rule result, it not available return the last computed result which may be stale. | ||
-- Errors out if none available. | ||
useWithStale_ ::(IdeRule k v) | ||
=> k -> NormalizedFilePath -> ExceptT e Action (v, PositionMapping) | ||
useWithStale_ key file = ExceptT $ fmap Right $ Shake.useWithStale_ key file | ||
|
||
useWithStale :: IdeRule k v | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Okay, so serious question: since we're in That would give us an (I think) sensible heuristic:
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. That also suggests that the functions here could just become "stricter" versions of |
||
=> k -> NormalizedFilePath -> ExceptT GhcidePluginError Action (v, PositionMapping) | ||
useWithStale key file = maybeToExceptT (FastRuleNotReady key) $ useWithStaleMaybeT key file | ||
|
||
-- | useE is useful to implement functions that aren’t rules but need shortcircuiting | ||
joyfulmantis marked this conversation as resolved.
Show resolved
Hide resolved
|
||
-- e.g. getDefinition. | ||
use :: IdeRule k v => k -> NormalizedFilePath -> ExceptT GhcidePluginError Action v | ||
use k = maybeToExceptT (RuleFailed k) . MaybeT . Shake.use k | ||
|
||
useWithStaleMaybeT :: IdeRule k v | ||
=> k -> NormalizedFilePath -> MaybeT Action (v, PositionMapping) | ||
useWithStaleMaybeT key file = MaybeT $ runIdentity <$> Shake.usesWithStale key (Identity file) | ||
|
||
-- ---------------------------------------------------------------------------- | ||
-- IdeAction wrappers | ||
-- ---------------------------------------------------------------------------- | ||
|
||
runIdeAction :: MonadIO m => String -> Shake.ShakeExtras -> ExceptT e IdeAction a -> ExceptT e m a | ||
runIdeAction _herald s i = ExceptT $ liftIO $ runReaderT (Shake.runIdeActionT $ runExceptT i) s | ||
|
||
-- | useE is useful to implement functions that aren’t rules but need shortcircuiting | ||
-- e.g. getDefinition. | ||
useWithStaleFast :: IdeRule k v => k -> NormalizedFilePath -> ExceptT GhcidePluginError IdeAction (v, PositionMapping) | ||
useWithStaleFast k = maybeToExceptT (RuleFailed k) . MaybeT . Shake.useWithStaleFast k | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I'm not totally sure why this gets a different error than |
||
|
||
uriToFilePath' :: Monad m => LSP.Uri -> ExceptT GhcidePluginError m FilePath | ||
uriToFilePath' uri = ExceptT . pure . maybeToEither (CoreError $ PluginUtils.PluginUriToFilePath uri) $ Location.uriToFilePath' uri | ||
|
||
-- ---------------------------------------------------------------------------- | ||
-- Internal Helper function, not exported | ||
-- ---------------------------------------------------------------------------- | ||
|
||
hoistAction :: Action a -> ExceptT e Action a | ||
hoistAction = ExceptT . fmap Right |
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -77,7 +77,7 @@ module Development.IDE.Core.Shake( | |
garbageCollectDirtyKeys, | ||
garbageCollectDirtyKeysOlderThan, | ||
Log(..), | ||
VFSModified(..), getClientConfigAction | ||
VFSModified(..), getClientConfigAction, | ||
) where | ||
|
||
import Control.Concurrent.Async | ||
|
@@ -964,11 +964,15 @@ useWithStale key file = runIdentity <$> usesWithStale key (Identity file) | |
|
||
-- | Request a Rule result, it not available return the last computed result which may be stale. | ||
-- Errors out if none available. | ||
-- | ||
-- The thrown error is a 'BadDependency' error which is caught by the rule system. | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Maybe link to the definition of |
||
useWithStale_ :: IdeRule k v | ||
=> k -> NormalizedFilePath -> Action (v, PositionMapping) | ||
useWithStale_ key file = runIdentity <$> usesWithStale_ key (Identity file) | ||
|
||
-- | Plural version of 'useWithStale_' | ||
-- | ||
-- The thrown error is a 'BadDependency' error which is caught by the rule system. | ||
usesWithStale_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f (v, PositionMapping)) | ||
usesWithStale_ key files = do | ||
res <- usesWithStale key files | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -28,9 +28,9 @@ import Development.IDE (GhcSession (..), | |
HscEnvEq (hscEnv), | ||
RuleResult, Rules, | ||
define, srcSpanToRange, | ||
usePropertyAction, | ||
useWithStale) | ||
usePropertyAction) | ||
import Development.IDE.Core.Compile (TcModuleResult (..)) | ||
import qualified Development.IDE.Core.PluginUtils as PluginUtils | ||
import Development.IDE.Core.PositionMapping (PositionMapping, | ||
toCurrentRange) | ||
import Development.IDE.Core.Rules (IdeState, runAction) | ||
|
@@ -51,7 +51,8 @@ import Development.IDE.Types.Logger (Pretty (pretty), | |
cmapWithPrio) | ||
import GHC.Generics (Generic) | ||
import Ide.Plugin.Properties | ||
import Ide.PluginUtils | ||
import Ide.PluginUtils (getNormalizedFilePath, | ||
mkLspCommand) | ||
import Ide.Types (CommandFunction, | ||
CommandId (CommandId), | ||
PluginCommand (PluginCommand), | ||
|
@@ -103,28 +104,22 @@ properties = emptyProperties | |
] Always | ||
|
||
codeLensProvider :: PluginMethodHandler IdeState TextDocumentCodeLens | ||
codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentifier uri} = pluginResponse $ do | ||
codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentifier uri} = PluginUtils.pluginResponse $ do | ||
mode <- liftIO $ runAction "codeLens.config" ideState $ usePropertyAction #mode pId properties | ||
nfp <- getNormalizedFilePath uri | ||
env <- hscEnv . fst | ||
<$> (handleMaybeM "Unable to get GhcSession" | ||
$ liftIO | ||
$ runAction "codeLens.GhcSession" ideState (useWithStale GhcSession nfp) | ||
) | ||
tmr <- fst <$> ( | ||
handleMaybeM "Unable to TypeCheck" | ||
$ liftIO | ||
$ runAction "codeLens.TypeCheck" ideState (useWithStale TypeCheck nfp) | ||
) | ||
bindings <- fst <$> ( | ||
handleMaybeM "Unable to GetBindings" | ||
$ liftIO | ||
$ runAction "codeLens.GetBindings" ideState (useWithStale GetBindings nfp) | ||
) | ||
nfp <- PluginUtils.withPluginError $ getNormalizedFilePath uri | ||
env <- hscEnv . fst <$> | ||
PluginUtils.runAction "codeLens.GhcSession" ideState | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Any reason not to merge these all into one There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I did not want to impose Plugin changes for no reason, to keep it easier to review. |
||
(PluginUtils.useWithStale GhcSession nfp) | ||
|
||
(tmr, _) <- PluginUtils.runAction "codeLens.TypeCheck" ideState | ||
(PluginUtils.useWithStale TypeCheck nfp) | ||
|
||
(bindings, _) <- PluginUtils.runAction "codeLens.GetBindings" ideState | ||
(PluginUtils.useWithStale GetBindings nfp) | ||
|
||
(gblSigs@(GlobalBindingTypeSigsResult gblSigs'), gblSigsMp) <- | ||
handleMaybeM "Unable to GetGlobalBindingTypeSigs" | ||
$ liftIO | ||
$ runAction "codeLens.GetGlobalBindingTypeSigs" ideState (useWithStale GetGlobalBindingTypeSigs nfp) | ||
PluginUtils.runAction "codeLens.GetGlobalBindingTypeSigs" ideState | ||
(PluginUtils.useWithStale GetGlobalBindingTypeSigs nfp) | ||
|
||
diag <- liftIO $ atomically $ getDiagnostics ideState | ||
hDiag <- liftIO $ atomically $ getHiddenDiagnostics ideState | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -15,15 +15,16 @@ import qualified Data.List as List | |
import qualified Data.Maybe as Maybe | ||
import Data.Text (Text, pack) | ||
import qualified Data.Text as Text | ||
import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, runAction, useWithStale, GhcSession (..), getFileContents, hscEnv) | ||
import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv) | ||
import Development.IDE.GHC.Compat | ||
import Development.IDE.GHC.Compat.Util | ||
import qualified Language.LSP.Types as LSP | ||
import Control.Monad.IO.Class (MonadIO (..)) | ||
import Control.Monad.Trans.Except (ExceptT) | ||
import Ide.Types (PluginId(..)) | ||
import qualified Data.Text as T | ||
import Ide.PluginUtils (handleMaybeM) | ||
import qualified Development.IDE.Core.PluginUtils as PluginUtils | ||
import Development.IDE.Core.PluginUtils (GhcidePluginError) | ||
|
||
getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo | ||
getNextPragmaInfo dynFlags sourceText = | ||
|
@@ -51,13 +52,13 @@ insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit prag | |
pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0 | ||
pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition | ||
|
||
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo | ||
getFirstPragma (PluginId pId) state nfp = handleMaybeM "Could not get NextPragmaInfo" $ do | ||
ghcSession <- liftIO $ runAction (T.unpack pId <> ".GhcSession") state $ useWithStale GhcSession nfp | ||
(_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp | ||
getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT GhcidePluginError m NextPragmaInfo | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. If we did what I suggested, this would "just" be in |
||
getFirstPragma (PluginId pId) state nfp = do | ||
ghcSession <- PluginUtils.runAction (T.unpack pId <> ".GhcSession") state $ PluginUtils.useWithStale GhcSession nfp | ||
(_, fileContents) <- PluginUtils.runAction (T.unpack pId <> ".GetFileContents") state $ PluginUtils.hoistAction $ getFileContents nfp | ||
case ghcSession of | ||
Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents | ||
Nothing -> pure Nothing | ||
(hscEnv -> hsc_dflags -> sessionDynFlags, _) -> | ||
pure $ getNextPragmaInfo sessionDynFlags fileContents | ||
|
||
-- Pre-declaration comments parser ----------------------------------------------------- | ||
|
||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,4 +1,5 @@ | ||
{-# LANGUAGE FlexibleContexts #-} | ||
{-# LANGUAGE LambdaCase #-} | ||
{-# LANGUAGE OverloadedStrings #-} | ||
{-# LANGUAGE TypeFamilies #-} | ||
module Ide.PluginUtils | ||
|
@@ -30,11 +31,22 @@ module Ide.PluginUtils | |
subRange, | ||
positionInRange, | ||
usePropertyLsp, | ||
getNormalizedFilePath, | ||
-- * Plugin Error Handling API | ||
PluginError(..), | ||
pluginResponse, | ||
pluginResponse', | ||
pluginResponseM, | ||
prettyPluginError, | ||
handlePluginError, | ||
mkPluginErrorMessage, | ||
hoistExceptT, | ||
handleMaybe, | ||
handleMaybeM, | ||
throwPluginError, | ||
mkSimpleResponseError, | ||
withError, | ||
-- * Batteries-included plugin error API | ||
getNormalizedFilePath, | ||
-- * Escape | ||
unescape, | ||
) | ||
where | ||
|
@@ -43,15 +55,17 @@ where | |
import Control.Arrow ((&&&)) | ||
import Control.Lens ((^.)) | ||
import Control.Monad.Extra (maybeM) | ||
import Control.Monad.IO.Class (MonadIO, liftIO) | ||
import Control.Monad.Trans.Class (lift) | ||
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) | ||
import Control.Monad.Trans.Except (ExceptT (..), mapExceptT, | ||
runExceptT, throwE, | ||
withExceptT) | ||
import Data.Algorithm.Diff | ||
import Data.Algorithm.DiffOutput | ||
import Data.Bifunctor (Bifunctor (first)) | ||
import Data.Char (isPrint, showLitChar) | ||
import Data.Functor (void) | ||
import qualified Data.HashMap.Strict as H | ||
import Data.String (IsString (fromString)) | ||
import qualified Data.Text as T | ||
import Data.Void (Void) | ||
import Ide.Plugin.Config | ||
|
@@ -263,27 +277,64 @@ allLspCmdIds pid commands = concatMap go commands | |
|
||
-- --------------------------------------------------------------------- | ||
|
||
getNormalizedFilePath :: Monad m => Uri -> ExceptT String m NormalizedFilePath | ||
getNormalizedFilePath uri = handleMaybe errMsg | ||
getNormalizedFilePath :: Monad m => Uri -> ExceptT PluginError m NormalizedFilePath | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. So if we did what I'm suggesting, we'd also provide
|
||
getNormalizedFilePath uri = handleMaybe (PluginUriToNormalizedFilePath uri) | ||
$ uriToNormalizedFilePath | ||
$ toNormalizedUri uri | ||
where | ||
errMsg = T.unpack $ "Failed converting " <> getUri uri <> " to NormalizedFilePath" | ||
|
||
-- --------------------------------------------------------------------- | ||
throwPluginError :: Monad m => String -> ExceptT String m b | ||
throwPluginError = throwE | ||
|
||
type PluginHandler e m a = ExceptT e m a | ||
|
||
pluginResponse :: Monad m => ExceptT PluginError m a -> m (Either ResponseError a) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. What about
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Hmm, we can't make it completely generic as it is now because of the attempt to fold the |
||
pluginResponse = | ||
fmap (first handlePluginError) | ||
. runExceptT | ||
|
||
pluginResponse' :: Monad m => (e -> ResponseError) -> ExceptT e m a -> m (Either ResponseError a) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is nearly There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Generally, I think if we can nudge people towards just using standard |
||
pluginResponse' handleError = | ||
fmap (first handleError) | ||
. runExceptT | ||
|
||
pluginResponseM :: Monad m => (t -> m (Either a b)) -> ExceptT t m b -> m (Either a b) | ||
pluginResponseM handler act = | ||
runExceptT act >>= \case | ||
Right r -> pure $ Right r | ||
Left err -> handler err | ||
|
||
handlePluginError :: PluginError -> ResponseError | ||
handlePluginError msg = ResponseError InternalError (prettyPluginError msg) Nothing | ||
|
||
data PluginError | ||
= PluginInternalError | ||
| PluginUriToFilePath J.Uri | ||
| PluginUriToNormalizedFilePath J.Uri | ||
| PluginErrorMessage T.Text | ||
|
||
prettyPluginError :: PluginError -> T.Text | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more.
|
||
prettyPluginError = \case | ||
PluginInternalError -> "Internal Plugin Error" | ||
PluginUriToFilePath uri -> "Failed to translate URI " <> T.pack (show uri) | ||
PluginUriToNormalizedFilePath uri -> "Failed converting " <> getUri uri <> " to NormalizedFilePath" | ||
PluginErrorMessage msg -> "Plugin failed: " <> msg | ||
|
||
mkPluginErrorMessage :: T.Text -> PluginError | ||
mkPluginErrorMessage = PluginErrorMessage | ||
|
||
mkSimpleResponseError :: T.Text -> ResponseError | ||
mkSimpleResponseError err = ResponseError InternalError err Nothing | ||
|
||
handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b | ||
handleMaybe msg = maybe (throwE msg) return | ||
|
||
handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b | ||
handleMaybeM msg act = maybeM (throwE msg) return $ lift act | ||
|
||
pluginResponse :: Monad m => ExceptT String m a -> m (Either ResponseError a) | ||
pluginResponse = | ||
fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing)) | ||
. runExceptT | ||
withError :: Functor m => (e' -> e) -> ExceptT e' m a -> ExceptT e m a | ||
withError = withExceptT | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Again, I think I'm broadly in favour of getting people to use "normal" |
||
|
||
hoistExceptT :: MonadIO m => ExceptT e IO a -> ExceptT e m a | ||
hoistExceptT = mapExceptT liftIO | ||
|
||
-- --------------------------------------------------------------------- | ||
|
||
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Can I request that we not use "errors out", it's very ambiguous when we have both
ExceptT
and exceptions in the picture. Maybe just "throws an exception"?