diff --git a/hls-explicit-record-fields-plugin.cabal b/hls-explicit-record-fields-plugin.cabal --- a/hls-explicit-record-fields-plugin.cabal +++ b/hls-explicit-record-fields-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hls-explicit-record-fields-plugin -version: 2.0.0.1 +version: 2.1.0.0 synopsis: Explicit record fields plugin for Haskell Language Server description: Please see the README on GitHub at @@ -29,8 +29,8 @@ -- other-extensions: build-depends: , base >=4.12 && <5 - , ghcide == 2.0.0.1 - , hls-plugin-api == 2.0.0.1 + , ghcide == 2.1.0.0 + , hls-plugin-api == 2.1.0.0 , lsp , lens , hls-graph diff --git a/src/Ide/Plugin/ExplicitFields.hs b/src/Ide/Plugin/ExplicitFields.hs --- a/src/Ide/Plugin/ExplicitFields.hs +++ b/src/Ide/Plugin/ExplicitFields.hs @@ -15,71 +15,71 @@ , Log ) where -import Control.Lens ((^.)) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Except (ExceptT) -import Data.Functor ((<&>)) -import Data.Generics (GenericQ, everything, extQ, - mkQ) -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe (fromMaybe, isJust, - listToMaybe, maybeToList) -import Data.Text (Text) -import Development.IDE (IdeState, NormalizedFilePath, - Pretty (..), Recorder (..), - Rules, WithPriority (..), - realSrcSpanToRange) -import Development.IDE.Core.Rules (runAction) -import Development.IDE.Core.RuleTypes (TcModuleResult (..), - TypeCheck (..)) -import Development.IDE.Core.Shake (define, use) -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.GHC.Compat (HsConDetails (RecCon), - HsRecFields (..), LPat, - Outputable, getLoc, recDotDot, - unLoc) -import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns), - GhcPass, - HsExpr (RecordCon, rcon_flds), - HsRecField, LHsExpr, LocatedA, - Name, Pass (..), Pat (..), - RealSrcSpan, UniqFM, - conPatDetails, emptyUFM, - hfbPun, hfbRHS, hs_valds, - lookupUFM, mapConPatDetail, - mapLoc, pattern RealSrcSpan, - plusUFM_C, ufmToIntMap, - unitUFM) -import Development.IDE.GHC.Util (getExtensions, - printOutputable) -import Development.IDE.Graph (RuleResult) -import Development.IDE.Graph.Classes (Hashable, NFData (rnf)) -import Development.IDE.Spans.Pragmas (NextPragmaInfo (..), - getFirstPragma, - insertNewPragma) -import Development.IDE.Types.Logger (Priority (..), cmapWithPrio, - logWith, (<+>)) -import GHC.Generics (Generic) -import Ide.Plugin.RangeMap (RangeMap) -import qualified Ide.Plugin.RangeMap as RangeMap -import Ide.PluginUtils (getNormalizedFilePath, - handleMaybeM, pluginResponse) -import Ide.Types (PluginDescriptor (..), - PluginId (..), - PluginMethodHandler, - defaultPluginDescriptor, - mkPluginHandler) -import Language.LSP.Types (CodeAction (..), - CodeActionKind (CodeActionRefactorRewrite), - CodeActionParams (..), - Command, List (..), - Method (..), SMethod (..), - TextEdit (..), - WorkspaceEdit (WorkspaceEdit), - fromNormalizedUri, - normalizedFilePathToUri, - type (|?) (InR)) -import qualified Language.LSP.Types.Lens as L +import Control.Lens ((^.)) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Except (ExceptT, runExceptT) +import Data.Functor ((<&>)) +import Data.Generics (GenericQ, everything, extQ, + mkQ) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe, isJust, + listToMaybe, maybeToList) +import Data.Text (Text) +import Development.IDE (IdeState, NormalizedFilePath, + Pretty (..), Recorder (..), + Rules, WithPriority (..), + realSrcSpanToRange) +import Development.IDE.Core.PluginUtils +import Development.IDE.Core.RuleTypes (TcModuleResult (..), + TypeCheck (..)) +import Development.IDE.Core.Shake (define, use) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.GHC.Compat (HsConDetails (RecCon), + HsRecFields (..), LPat, + Outputable, getLoc, + recDotDot, unLoc) +import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns), + GhcPass, + HsExpr (RecordCon, rcon_flds), + HsRecField, LHsExpr, + LocatedA, Name, Pass (..), + Pat (..), RealSrcSpan, + UniqFM, conPatDetails, + emptyUFM, hfbPun, hfbRHS, + hs_valds, lookupUFM, + mapConPatDetail, mapLoc, + pattern RealSrcSpan, + plusUFM_C, ufmToIntMap, + unitUFM) +import Development.IDE.GHC.Util (getExtensions, + printOutputable) +import Development.IDE.Graph (RuleResult) +import Development.IDE.Graph.Classes (Hashable, NFData (rnf)) +import Development.IDE.Spans.Pragmas (NextPragmaInfo (..), + getFirstPragma, + insertNewPragma) +import GHC.Generics (Generic) +import Ide.Logger (Priority (..), cmapWithPrio, + logWith, (<+>)) +import Ide.Plugin.Error (PluginError, + getNormalizedFilePathE) +import Ide.Plugin.RangeMap (RangeMap) +import qualified Ide.Plugin.RangeMap as RangeMap +import Ide.Types (PluginDescriptor (..), + PluginId (..), + PluginMethodHandler, + defaultPluginDescriptor, + mkPluginHandler) +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message (Method (..), SMethod (..)) +import Language.LSP.Protocol.Types (CodeAction (..), + CodeActionKind (CodeActionKind_RefactorRewrite), + CodeActionParams (..), + Command, TextEdit (..), + WorkspaceEdit (WorkspaceEdit), + fromNormalizedUri, + normalizedFilePathToUri, + type (|?) (InL, InR)) data Log @@ -95,29 +95,29 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider + { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction codeActionProvider , pluginRules = collectRecordsRule recorder *> collectNamesRule } -codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction -codeActionProvider ideState pId (CodeActionParams _ _ docId range _) = pluginResponse $ do - nfp <- getNormalizedFilePath (docId ^. L.uri) +codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction +codeActionProvider ideState pId (CodeActionParams _ _ docId range _) = do + nfp <- getNormalizedFilePathE (docId ^. L.uri) pragma <- getFirstPragma pId ideState nfp CRR recMap exts <- collectRecords' ideState nfp let actions = map (mkCodeAction nfp exts pragma) (RangeMap.filterByRange range recMap) - pure $ List actions + pure $ InL actions where mkCodeAction :: NormalizedFilePath -> [Extension] -> NextPragmaInfo -> RenderedRecordInfo -> Command |? CodeAction mkCodeAction nfp exts pragma rec = InR CodeAction { _title = mkCodeActionTitle exts - , _kind = Just CodeActionRefactorRewrite + , _kind = Just CodeActionKind_RefactorRewrite , _diagnostics = Nothing , _isPreferred = Nothing , _disabled = Nothing , _edit = Just $ mkWorkspaceEdit nfp edits , _command = Nothing - , _xdata = Nothing + , _data_ = Nothing } where edits = mkTextEdit rec : maybeToList pragmaEdit @@ -133,7 +133,7 @@ mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing where - changes = Just $ HashMap.singleton (fromNormalizedUri (normalizedFilePathToUri nfp)) (List edits) + changes = Just $ Map.singleton (fromNormalizedUri (normalizedFilePathToUri nfp)) edits mkCodeActionTitle :: [Extension] -> Text mkCodeActionTitle exts = @@ -358,10 +358,7 @@ [ RecordInfoPat realSpan' (unLoc pat) | RealSrcSpan realSpan' _ <- [ getLoc pat ]] getRecPatterns _ = Nothing -collectRecords' :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m CollectRecordsResult -collectRecords' ideState = - handleMaybeM "Unable to TypeCheck" - . liftIO - . runAction "ExplicitFields" ideState - . use CollectRecords +collectRecords' :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT PluginError m CollectRecordsResult +collectRecords' ideState = runActionE "ExplicitFields" ideState + . useE CollectRecords