hls-retrie-plugin 0.1.1.0 → 0.1.1.1
raw patch · 2 files changed
+28/−30 lines, 2 filesdep +lspdep +lsp-typesdep −haskell-lspdep −haskell-lsp-typesPVP ok
version bump matches the API change (PVP)
Dependencies added: lsp, lsp-types
Dependencies removed: haskell-lsp, haskell-lsp-types
API changes (from Hackage documentation)
Files
- hls-retrie-plugin.cabal +5/−3
- src/Ide/Plugin/Retrie.hs +23/−27
hls-retrie-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hls-retrie-plugin-version: 0.1.1.0+version: 0.1.1.1 synopsis: Retrie integration plugin for Haskell Language Server license: Apache-2.0 license-file: LICENSE@@ -21,8 +21,8 @@ , deepseq , directory , extra- , haskell-lsp- , haskell-lsp-types+ , lsp+ , lsp-types , hls-plugin-api , ghc , ghcide@@ -36,3 +36,5 @@ default-language: Haskell2010 include-dirs: include+ default-extensions: DataKinds, TypeOperators+ ghc-options: -Wno-unticked-promoted-constructors
src/Ide/Plugin/Retrie.hs view
@@ -38,7 +38,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Typeable (Typeable)-import Development.IDE+import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.Shake (toKnownFiles, ShakeExtras(knownTargetsVar)) import Development.IDE.GHC.Compat (GenLocated (L), GhcRn, HsBindLR (FunBind),@@ -65,9 +65,8 @@ rdrNameOcc, unpackFS) import Ide.PluginUtils import Ide.Types-import Language.Haskell.LSP.Core (LspFuncs (..), ProgressCancellable (Cancellable))-import Language.Haskell.LSP.Messages (FromServerMessage (NotShowMessage))-import Language.Haskell.LSP.Types as J+import Language.LSP.Server (ProgressCancellable (Cancellable), withIndefiniteProgress, LspM, sendRequest, sendNotification)+import Language.LSP.Types as J import Retrie.CPP (CPP (NoCPP), parseCPP) import Retrie.ExactPrint (fix, relativiseApiAnns, transformA, unsafeMkA)@@ -90,7 +89,7 @@ descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId)- { pluginCodeActionProvider = Just provider,+ { pluginHandlers = mkPluginHandler STextDocumentCodeAction provider, pluginCommands = [retrieCommand] } @@ -110,21 +109,20 @@ } deriving (Eq, Show, Generic, FromJSON, ToJSON) runRetrieCmd ::- LspFuncs a -> IdeState -> RunRetrieParams ->- IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))-runRetrieCmd lsp state RunRetrieParams{originatingFile = uri, ..} =- withIndefiniteProgress lsp description Cancellable $ do- res <- runMaybeT $ do+ LspM c (Either ResponseError Value)+runRetrieCmd state RunRetrieParams{originatingFile = uri, ..} =+ withIndefiniteProgress description Cancellable $ do+ runMaybeT $ do nfp <- MaybeT $ return $ uriToNormalizedFilePath $ toNormalizedUri uri- (session, _) <- MaybeT $+ (session, _) <- MaybeT $ liftIO $ runAction "Retrie.GhcSessionDeps" state $ useWithStale GhcSessionDeps nfp- (ms, binds, _, _, _) <- MaybeT $ runAction "Retrie.getBinds" state $ getBinds nfp+ (ms, binds, _, _, _) <- MaybeT $ liftIO $ runAction "Retrie.getBinds" state $ getBinds nfp let importRewrites = concatMap (extractImports ms binds) rewrites- (errors, edits) <- lift $+ (errors, edits) <- liftIO $ callRetrie state (hscEnv session)@@ -132,16 +130,14 @@ nfp restrictToOriginatingFile unless (null errors) $- lift $ sendFunc lsp $- NotShowMessage $- NotificationMessage "2.0" WindowShowMessage $+ lift $ sendNotification SWindowShowMessage $ ShowMessageParams MtWarning $ T.unlines $ "## Found errors during rewrite:" : ["-" <> T.pack (show e) | e <- errors]- return (WorkspaceApplyEdit, ApplyWorkspaceEditParams edits)- return- (Right Null, res)+ lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edits) (\_ -> pure ())+ return ()+ return $ Right Null extractImports :: ModSummary -> [HsBindLR GhcRn GhcRn] -> RewriteSpec -> [ImportSpec] extractImports ModSummary{ms_mod} topLevelBinds (Unfold thing)@@ -166,14 +162,14 @@ ------------------------------------------------------------------------------- -provider :: CodeActionProvider IdeState-provider _a state plId (TextDocumentIdentifier uri) range ca = response $ do+provider :: PluginMethodHandler IdeState TextDocumentCodeAction+provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca) = response $ do let (J.CodeActionContext _diags _monly) = ca nuri = toNormalizedUri uri nfp <- handleMaybe "uri" $ uriToNormalizedFilePath nuri (ModSummary{ms_mod}, topLevelBinds, posMapping, hs_ruleds, hs_tyclds)- <- handleMaybeM "typecheck" $ runAction "retrie" state $ getBinds nfp+ <- handleMaybeM "typecheck" $ liftIO $ runAction "retrie" state $ getBinds nfp pos <- handleMaybe "pos" $ _start <$> fromCurrentRange posMapping range let rewrites =@@ -188,11 +184,11 @@ ] commands <- lift $- forM rewrites $ \(title, kind, params) -> do- c <- mkLspCommand plId (coerce retrieCommandName) title (Just [toJSON params])- return $ CodeAction title (Just kind) Nothing Nothing (Just c)+ forM rewrites $ \(title, kind, params) -> liftIO $ do+ let c = mkLspCommand plId (coerce retrieCommandName) title (Just [toJSON params])+ return $ CodeAction title (Just kind) Nothing Nothing Nothing Nothing (Just c) - return $ J.List [CACodeAction c | c <- commands]+ return $ J.List [InR c | c <- commands] getBinds :: NormalizedFilePath -> Action (Maybe (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping, [LRuleDecls GhcRn], [TyClGroup GhcRn])) getBinds nfp = runMaybeT $ do@@ -491,7 +487,7 @@ handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b handleMaybeM msg act = maybe (throwE msg) return =<< lift act -response :: ExceptT String IO a -> IO (Either ResponseError a)+response :: Monad m => ExceptT String m a -> m (Either ResponseError a) response = fmap (first (\msg -> ResponseError InternalError (fromString msg) Nothing)) . runExceptT