Better plugin error infrastructure

ghcide/ghcide.cabal

@@ -154,6 +154,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

ghcide/src/Development/IDE.hs

@@ -8,9 +8,7 @@ module Development.IDE
 
 import           Development.IDE.Core.Actions          as X (getAtPoint,
                                                              getDefinition,
-                                                             getTypeDefinition,
-                                                             useE, useNoFileE,
-                                                             usesE)
+                                                             getTypeDefinition)
 import           Development.IDE.Core.FileExists       as X (getFileExists)
 import           Development.IDE.Core.FileStore        as X (getFileContents)
 import           Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),
@@ -55,4 +53,4 @@ import           Development.IDE.Types.HscEnvEq        as X (HscEnvEq (..),
                                                              hscEnv,
                                                              hscEnvWithImportPaths)
 import           Development.IDE.Types.Location        as X
-import           Ide.Logger          as X
+import           Ide.Logger                            as X

ghcide/src/Development/IDE/Core/Actions.hs

@@ -6,9 +6,6 @@ module Development.IDE.Core.Actions
 , getTypeDefinition
 , highlightAtPoint
 , refsAtPoint
-, useE
-, useNoFileE
-, usesE
 , workspaceSymbols
 , lookupMod
 ) where
@@ -21,6 +18,7 @@ import           Data.Maybe
 import qualified Data.Text                            as T
 import           Data.Tuple.Extra
 import           Development.IDE.Core.OfInterest
+import           Development.IDE.Core.PluginUtils
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Service
@@ -49,7 +47,7 @@ lookupMod
 lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing
 
 
--- IMPORTANT NOTE : make sure all rules `useE`d by these have a "Persistent Stale" rule defined,
+-- IMPORTANT NOTE : make sure all rules `useWithStaleFastMT`d by these have a "Persistent Stale" rule defined,
 -- so we can quickly answer as soon as the IDE is opened
 -- Even if we don't have persistent information on disk for these rules, the persistent rule
 -- should just return an empty result
@@ -62,9 +60,9 @@ getAtPoint file pos = runMaybeT $ do
   ide <- ask
   opts <- liftIO $ getIdeOptionsIO ide
 
-  (hf, mapping) <- useE GetHieAst file
-  env <- hscEnv . fst <$> useE GhcSession file
-  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useE GetDocMap file)
+  (hf, mapping) <- useWithStaleFastMT GetHieAst file
+  env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file
+  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
 
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
   MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap env pos'
@@ -94,30 +92,19 @@ toCurrentLocations mapping file = mapMaybeM go
       else do
         otherLocationMapping <- fmap (fmap snd) $ runMaybeT $ do
           otherLocationFile <- MaybeT $ pure $ uriToNormalizedFilePath nUri
-          useE GetHieAst otherLocationFile
+          useWithStaleFastMT GetHieAst otherLocationFile
         pure $ Location uri <$> (flip toCurrentRange range =<< otherLocationMapping)
       where
         nUri :: NormalizedUri
         nUri = toNormalizedUri uri
 
--- | useE is useful to implement functions that aren’t rules but need shortcircuiting
--- e.g. getDefinition.
-useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
-useE k = MaybeT . useWithStaleFast k
-
-useNoFileE :: IdeRule k v => IdeState -> k -> MaybeT IdeAction v
-useNoFileE _ide k = fst <$> useE k emptyFilePath
-
-usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT IdeAction [(v,PositionMapping)]
-usesE k = MaybeT . fmap sequence . mapM (useWithStaleFast k)
-
 -- | Goto Definition.
 getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
 getDefinition file pos = runMaybeT $ do
     ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask
     opts <- liftIO $ getIdeOptionsIO ide
-    (HAR _ hf _ _ _, mapping) <- useE GetHieAst file
-    (ImportMap imports, _) <- useE GetImportMap file
+    (HAR _ hf _ _ _, mapping) <- useWithStaleFastMT GetHieAst file
+    (ImportMap imports, _) <- useWithStaleFastMT GetImportMap file
     !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos)
     locations <- AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos'
     MaybeT $ Just <$> toCurrentLocations mapping file locations
@@ -126,14 +113,14 @@ getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Locatio
 getTypeDefinition file pos = runMaybeT $ do
     ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask
     opts <- liftIO $ getIdeOptionsIO ide
-    (hf, mapping) <- useE GetHieAst file
+    (hf, mapping) <- useWithStaleFastMT GetHieAst file
     !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
     locations <- AtPoint.gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts hf pos'
     MaybeT $ Just <$> toCurrentLocations mapping file locations
 
 highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])
 highlightAtPoint file pos = runMaybeT $ do
-    (HAR _ hf rf _ _,mapping) <- useE GetHieAst file
+    (HAR _ hf rf _ _,mapping) <- useWithStaleFastMT GetHieAst file
     !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
     let toCurrentHighlight (DocumentHighlight range t) = flip DocumentHighlight t <$> toCurrentRange mapping range
     mapMaybe toCurrentHighlight <$>AtPoint.documentHighlight hf rf pos'

ghcide/src/Development/IDE/Core/PluginUtils.hs

@@ -0,0 +1,132 @@
+{-# 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.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 Ide.Logger                           as Logger
+import           Ide.Plugin.Error
+import qualified Language.LSP.Protocol.Types          as LSP
+
+-- ----------------------------------------------------------------------------
+-- Action wrappers
+-- ----------------------------------------------------------------------------
+
+-- |ExceptT version of `runAction`, takes a ExceptT Action
+runActionE :: MonadIO m => String -> IdeState -> ExceptT e Action a -> ExceptT e m a
+runActionE herald ide act =
+  mapExceptT liftIO . ExceptT $
+    join $ shakeEnqueue (shakeExtras ide) (mkDelayedAction herald Logger.Debug $ runExceptT act)
+
+-- |MaybeT version of `runAction`, takes a MaybeT Action
+runActionMT :: MonadIO m => String -> IdeState -> MaybeT Action a -> MaybeT m a
+runActionMT herald ide act =
+  mapMaybeT liftIO . MaybeT $
+    join $ shakeEnqueue (shakeExtras ide) (mkDelayedAction herald Logger.Debug $ runMaybeT act)
+
+-- |ExceptT version of `use` that throws a PluginRuleFailed upon failure
+useE :: IdeRule k v => k -> NormalizedFilePath -> ExceptT PluginError Action v
+useE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . useMT k
+
+-- |MaybeT version of `use`
+useMT :: IdeRule k v => k -> NormalizedFilePath -> MaybeT Action v
+useMT k = MaybeT . Shake.use k
+
+-- |ExceptT version of `useWithStale` that throws a PluginRuleFailed upon
+-- failure
+useWithStaleE :: IdeRule k v
+    => k -> NormalizedFilePath -> ExceptT PluginError Action (v, PositionMapping)
+useWithStaleE key = maybeToExceptT (PluginRuleFailed (T.pack $ show key)) . useWithStaleMT key
+
+-- |MaybeT version of `useWithStale`
+useWithStaleMT :: IdeRule k v
+    => k -> NormalizedFilePath -> MaybeT Action (v, PositionMapping)
+useWithStaleMT key file = MaybeT $ runIdentity <$> Shake.usesWithStale key (Identity file)
+
+-- ----------------------------------------------------------------------------
+-- IdeAction wrappers
+-- ----------------------------------------------------------------------------
+
+-- |ExceptT version of `runIdeAction`, takes a ExceptT IdeAction
+runIdeActionE :: MonadIO m => String -> Shake.ShakeExtras -> ExceptT e IdeAction a -> ExceptT e m a
+runIdeActionE _herald s i = ExceptT $ liftIO $ runReaderT (Shake.runIdeActionT $ runExceptT i) s
+
+-- |MaybeT version of `runIdeAction`, takes a MaybeT IdeAction
+runIdeActionMT :: MonadIO m => String -> Shake.ShakeExtras -> MaybeT IdeAction a -> MaybeT m a
+runIdeActionMT _herald s i = MaybeT $ liftIO $ runReaderT (Shake.runIdeActionT $ runMaybeT i) s
+
+-- |ExceptT version of `useWithStaleFast` that throws a PluginRuleFailed upon
+-- failure
+useWithStaleFastE :: IdeRule k v => k -> NormalizedFilePath -> ExceptT PluginError IdeAction (v, PositionMapping)
+useWithStaleFastE k = maybeToExceptT (PluginRuleFailed (T.pack $ show k)) . useWithStaleFastMT k
+
+-- |MaybeT version of `useWithStaleFast`
+useWithStaleFastMT :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
+useWithStaleFastMT k = MaybeT . Shake.useWithStaleFast k
+
+-- ----------------------------------------------------------------------------
+-- Location wrappers
+-- ----------------------------------------------------------------------------
+
+-- |ExceptT version of `uriToFilePath` that throws a PluginInvalidParams upon
+-- failure
+uriToFilePathE :: Monad m => LSP.Uri -> ExceptT PluginError m FilePath
+uriToFilePathE uri = maybeToExceptT (PluginInvalidParams (T.pack $ "uriToFilePath' failed. Uri:" <>  show uri)) $ uriToFilePathMT uri
+
+-- |MaybeT version of `uriToFilePath`
+uriToFilePathMT :: Monad m => LSP.Uri -> MaybeT m FilePath
+uriToFilePathMT = MaybeT . pure . Location.uriToFilePath'
+
+-- ----------------------------------------------------------------------------
+-- PositionMapping wrappers
+-- ----------------------------------------------------------------------------
+
+-- |ExceptT version of `toCurrentPosition` that throws a PluginDependencyFailed
+-- upon failure
+toCurrentPositionE :: Monad m => PositionMapping -> LSP.Position -> ExceptT PluginError m LSP.Position
+toCurrentPositionE mapping = maybeToExceptT (PluginDependencyFailed "toCurrentPosition"). toCurrentPositionMT mapping
+
+-- |MaybeT version of `toCurrentPosition`
+toCurrentPositionMT :: Monad m => PositionMapping -> LSP.Position -> MaybeT m LSP.Position
+toCurrentPositionMT mapping = MaybeT . pure . toCurrentPosition mapping
+
+-- |ExceptT version of `fromCurrentPosition` that throws a PluginDependencyFailed
+-- upon failure
+fromCurrentPositionE :: Monad m => PositionMapping -> LSP.Position -> ExceptT PluginError m LSP.Position
+fromCurrentPositionE mapping = maybeToExceptT (PluginDependencyFailed "fromCurrentPosition") . fromCurrentPositionMT mapping
+
+-- |MaybeT version of `fromCurrentPosition`
+fromCurrentPositionMT :: Monad m => PositionMapping -> LSP.Position -> MaybeT m LSP.Position
+fromCurrentPositionMT mapping = MaybeT . pure . fromCurrentPosition mapping
+
+-- |ExceptT version of `toCurrentRange` that throws a PluginDependencyFailed
+-- upon failure
+toCurrentRangeE :: Monad m => PositionMapping -> LSP.Range -> ExceptT PluginError m LSP.Range
+toCurrentRangeE mapping = maybeToExceptT (PluginDependencyFailed "toCurrentRange") . toCurrentRangeMT mapping
+
+-- |MaybeT version of `toCurrentRange`
+toCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Range
+toCurrentRangeMT mapping = MaybeT . pure . toCurrentRange mapping
+
+-- |ExceptT version of `fromCurrentRange` that throws a PluginDependencyFailed
+-- upon failure
+fromCurrentRangeE :: Monad m => PositionMapping -> LSP.Range -> ExceptT PluginError m LSP.Range
+fromCurrentRangeE mapping = maybeToExceptT (PluginDependencyFailed "fromCurrentRange") . fromCurrentRangeMT mapping
+
+-- |MaybeT version of `fromCurrentRange`
+fromCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Range
+fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping

ghcide/src/Development/IDE/Core/Shake.hs

@@ -77,7 +77,7 @@ module Development.IDE.Core.Shake(
     garbageCollectDirtyKeys,
     garbageCollectDirtyKeysOlderThan,
     Log(..),
-    VFSModified(..), getClientConfigAction
+    VFSModified(..), getClientConfigAction,
     ) where
 
 import           Control.Concurrent.Async
@@ -152,15 +152,15 @@ import           Development.IDE.Types.Exports
 import qualified Development.IDE.Types.Exports          as ExportsMap
 import           Development.IDE.Types.KnownTargets
 import           Development.IDE.Types.Location
-import           Ide.Logger           hiding (Priority)
-import qualified Ide.Logger           as Logger
 import           Development.IDE.Types.Monitoring       (Monitoring (..))
 import           Development.IDE.Types.Options
 import           Development.IDE.Types.Shake
 import qualified Focus
 import           GHC.Fingerprint
 import           GHC.Stack                              (HasCallStack)
 import           HieDb.Types
+import           Ide.Logger                             hiding (Priority)
+import qualified Ide.Logger                             as Logger
 import           Ide.Plugin.Config
 import qualified Ide.PluginUtils                        as HLS
 import           Ide.Types                              (IdePlugins (IdePlugins),
@@ -963,11 +963,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.
 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

ghcide/src/Development/IDE/Core/Tracing.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE PackageImports  #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# HLINT ignore #-}
+
 module Development.IDE.Core.Tracing
     ( otTracedHandler
     , otTracedAction

ghcide/src/Development/IDE/LSP/HoverDefinition.hs

@@ -15,43 +15,43 @@ module Development.IDE.LSP.HoverDefinition
     , wsSymbols
     ) where
 
+import           Control.Monad.Except           (ExceptT)
 import           Control.Monad.IO.Class
 import           Data.Maybe                     (fromMaybe)
 import           Development.IDE.Core.Actions
 import           Development.IDE.Core.Rules
 import           Development.IDE.Core.Shake
 import           Development.IDE.Types.Location
 import           Ide.Logger
+import           Ide.Plugin.Error
+import           Ide.Types
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
 import qualified Language.LSP.Server            as LSP
 
 import qualified Data.Text                      as T
 
-gotoDefinition :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (MessageResult Method_TextDocumentDefinition))
-hover          :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (Hover |? Null))
-gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (MessageResult Method_TextDocumentTypeDefinition))
-documentHighlight :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError ([DocumentHighlight] |? Null))
+gotoDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult Method_TextDocumentDefinition)
+hover          :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (Hover |? Null)
+gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult Method_TextDocumentTypeDefinition)
+documentHighlight :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) ([DocumentHighlight] |? Null)
 gotoDefinition = request "Definition" getDefinition (InR $ InR Null) (InL . Definition. InR)
 gotoTypeDefinition = request "TypeDefinition" getTypeDefinition (InR $ InR Null) (InL . Definition. InR)
 hover          = request "Hover"      getAtPoint     (InR Null)     foundHover
 documentHighlight = request "DocumentHighlight" highlightAtPoint (InR Null) InL
 
-references :: IdeState -> ReferenceParams -> LSP.LspM c (Either ResponseError ([Location] |? Null))
-references ide (ReferenceParams (TextDocumentIdentifier uri) pos _ _ _) = liftIO $
-  case uriToFilePath' uri of
-    Just path -> do
-      let filePath = toNormalizedFilePath' path
-      logDebug (ideLogger ide) $
+references :: PluginMethodHandler IdeState 'Method_TextDocumentReferences
+references ide _ (ReferenceParams (TextDocumentIdentifier uri) pos _ _ _) = do
+  nfp <- getNormalizedFilePathE uri
+  liftIO $ logDebug (ideLogger ide) $
         "References request at position " <> T.pack (showPosition pos) <>
-        " in file: " <> T.pack path
-      Right . InL <$> (runAction "references" ide $ refsAtPoint filePath pos)
-    Nothing -> pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) ("Invalid URI " <> T.pack (show uri)) Nothing
+        " in file: " <> T.pack (show nfp)
+  InL <$> (liftIO $ runAction "references" ide $ refsAtPoint nfp pos)
 
-wsSymbols :: IdeState -> WorkspaceSymbolParams -> LSP.LspM c (Either ResponseError [SymbolInformation])
-wsSymbols ide (WorkspaceSymbolParams _ _ query) = liftIO $ do
+wsSymbols :: PluginMethodHandler IdeState 'Method_WorkspaceSymbol
+wsSymbols ide _ (WorkspaceSymbolParams _ _ query) = liftIO $ do
   logDebug (ideLogger ide) $ "Workspace symbols request: " <> query
-  runIdeAction "WorkspaceSymbols" (shakeExtras ide) $ Right . fromMaybe [] <$> workspaceSymbols query
+  runIdeAction "WorkspaceSymbols" (shakeExtras ide) $ InL . fromMaybe [] <$> workspaceSymbols query
 
 foundHover :: (Maybe Range, [T.Text]) -> Hover |? Null
 foundHover (mbRange, contents) =
@@ -65,12 +65,12 @@ request
   -> (a -> b)
   -> IdeState
   -> TextDocumentPositionParams
-  -> LSP.LspM c (Either ResponseError b)
+  -> ExceptT PluginError (LSP.LspM c) b
 request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = liftIO $ do
     mbResult <- case uriToFilePath' uri of
         Just path -> logAndRunRequest label getResults ide pos path
         Nothing   -> pure Nothing
-    pure $ Right $ maybe notFound found mbResult
+    pure $ maybe notFound found mbResult
 
 logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> IdeAction b) -> IdeState -> Position -> String -> IO b
 logAndRunRequest label getResults ide pos path = do