Skip to content

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

Closed
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
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/ghcide.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -153,6 +153,7 @@ library
Development.IDE.Core.FileUtils
Development.IDE.Core.IdeConfiguration
Development.IDE.Core.OfInterest
Development.IDE.Core.PluginUtils
Development.IDE.Core.PositionMapping
Development.IDE.Core.Preprocessor
Development.IDE.Core.ProgressReporting
Expand Down
108 changes: 108 additions & 0 deletions ghcide/src/Development/IDE/Core/PluginUtils.hs
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.
Copy link
Collaborator

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"?

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
Copy link
Collaborator

Choose a reason for hiding this comment

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

Okay, so serious question: since we're in Action here, and it's safe to throw exceptions, is there any reason not to throw these errors as exceptions too?

That would give us an (I think) sensible heuristic:

  • Functions that run in Action throw exceptions
  • Functions that run outside Action use ExceptT

Copy link
Collaborator

Choose a reason for hiding this comment

The 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 useWithStale and friends, which throw RuleNotReady instead of RuleFailed or whatever. Then this module mostly goes away and we instead add a few functions to Shake.hs

=> 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
-- 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
Copy link
Collaborator

Choose a reason for hiding this comment

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

I'm not totally sure why this gets a different error than useWithStale 🤔 More generally I think it would be good for the errors to match the function names. We can rename the functions... but let's keep the two consistent.


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
2 changes: 2 additions & 0 deletions ghcide/src/Development/IDE/Core/Service.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ import qualified Language.LSP.Server as LSP
import qualified Language.LSP.Types as LSP

import Control.Monad
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import qualified Development.IDE.Core.FileExists as FileExists
import qualified Development.IDE.Core.OfInterest as OfInterest
import Development.IDE.Core.Shake hiding (Log)
Expand Down
6 changes: 5 additions & 1 deletion ghcide/src/Development/IDE/Core/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@ module Development.IDE.Core.Shake(
garbageCollectDirtyKeys,
garbageCollectDirtyKeysOlderThan,
Log(..),
VFSModified(..), getClientConfigAction
VFSModified(..), getClientConfigAction,
) where

import Control.Concurrent.Async
Expand Down Expand Up @@ -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.
Copy link
Collaborator

Choose a reason for hiding this comment

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

Maybe link to the definition of Action, which also explains that it's okay to throw inside Actions.

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
Expand Down
1 change: 1 addition & 0 deletions ghcide/src/Development/IDE/Core/Tracing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PatternSynonyms #-}
{-# HLINT ignore #-}

module Development.IDE.Core.Tracing
( otTracedHandler
, otTracedAction
Expand Down
41 changes: 18 additions & 23 deletions ghcide/src/Development/IDE/Plugin/TypeLenses.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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),
Expand Down Expand Up @@ -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
Copy link
Collaborator

Choose a reason for hiding this comment

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

Any reason not to merge these all into one Action?

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 did not want to impose Plugin changes for no reason, to keep it easier to review.
Also, I think some people prefer this style, because otherwise you have to return a big tuple and pattern match on it. I don't think there is any performance impact.

(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
Expand Down
17 changes: 9 additions & 8 deletions ghcide/src/Development/IDE/Spans/Pragmas.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Copy link
Collaborator

Choose a reason for hiding this comment

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

If we did what I suggested, this would "just" be in MonadIO. I think that's okay: if it's in MonadIO it can throw!

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 -----------------------------------------------------

Expand Down
79 changes: 65 additions & 14 deletions hls-plugin-api/src/Ide/PluginUtils.hs
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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Copy link
Collaborator

Choose a reason for hiding this comment

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

So if we did what I'm suggesting, we'd also provide

getNormalizedFilePathIO :: MonadIO m => Uri -> m NormalizedFilePath

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)
Copy link
Collaborator

Choose a reason for hiding this comment

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

What about

handlePluginError :: Pretty e => e -> ResponseError
handlePluginError msg = ResponseError Internalerror (renderPrettyWhatever msg) Nothing

pluginResponse :: Monad m => ExceptT e m a -> m (Either ResponseError a)

pluginResponse' is more generic still but I'm not sure if people really need that power?

Copy link
Collaborator

Choose a reason for hiding this comment

The 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 getNormalizedFilePath functions in...

pluginResponse =
fmap (first handlePluginError)
. runExceptT

pluginResponse' :: Monad m => (e -> ResponseError) -> ExceptT e m a -> m (Either ResponseError a)
Copy link
Collaborator

Choose a reason for hiding this comment

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

This is nearly pluginResponse . withExceptT handleError, right? Maybe we should just let people do this inline, withExceptT is not so exotic...

Copy link
Collaborator

Choose a reason for hiding this comment

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

Generally, I think if we can nudge people towards just using standard Control.Monad.Except stuff that seems good

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
Copy link
Collaborator

Choose a reason for hiding this comment

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

instance Pretty PluginError?

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
Copy link
Collaborator

Choose a reason for hiding this comment

The 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" ExceptT functions as much as possible.


hoistExceptT :: MonadIO m => ExceptT e IO a -> ExceptT e m a
hoistExceptT = mapExceptT liftIO

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

Expand Down
Loading