hls-gadt-plugin 2.0.0.1 → 2.1.0.0
raw patch · 3 files changed
+74/−48 lines, 3 filesdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils, lsp
API changes (from Hackage documentation)
Files
- hls-gadt-plugin.cabal +5/−5
- src/Ide/Plugin/GADT.hs +67/−41
- test/Main.hs +2/−2
hls-gadt-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-gadt-plugin-version: 2.0.0.1+version: 2.1.0.0 synopsis: Convert to GADT syntax plugin description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server/tree/master/plugins/hls-gadt-plugin#readme>@@ -30,13 +30,13 @@ , containers , extra , ghc- , ghcide == 2.0.0.1+ , ghcide == 2.1.0.0 , ghc-boot-th , ghc-exactprint- , hls-plugin-api == 2.0.0.1+ , hls-plugin-api == 2.1.0.0 , hls-refactor-plugin , lens- , lsp >=1.2.0.1+ , lsp >=2.1.0.0 , mtl , text , transformers@@ -59,7 +59,7 @@ , base , filepath , hls-gadt-plugin- , hls-test-utils == 2.0.0.1+ , hls-test-utils == 2.1.0.0 , lens , lsp , lsp-test
src/Ide/Plugin/GADT.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -8,33 +9,39 @@ {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.GADT (descriptor) where -import Control.Monad.Trans.Class-import Control.Monad.IO.Class-import Control.Lens ((^.))-import Control.Monad.Except-import Data.Aeson (FromJSON, ToJSON, Value (Null),- toJSON)-import Data.Either.Extra (maybeToEither)-import qualified Data.HashMap.Lazy as HashMap-import qualified Data.Text as T+import Control.Lens ((^.))++import Control.Monad.Error.Class (MonadError (throwError),+ liftEither)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.Trans.Except (ExceptT, runExceptT,+ withExceptT)+import Data.Aeson (FromJSON, ToJSON, toJSON)+import Data.Either.Extra (maybeToEither)+import qualified Data.Map as Map+import qualified Data.Text as T import Development.IDE import Development.IDE.GHC.Compat -import Control.Monad.Trans.Except (throwE)-import Data.Maybe (mapMaybe)-import Development.IDE.Spans.Pragmas (getFirstPragma, insertNewPragma)-import GHC.Generics (Generic)+import Data.Maybe (mapMaybe)+import Development.IDE.Core.PluginUtils+import Development.IDE.Spans.Pragmas (getFirstPragma,+ insertNewPragma)+import GHC.Generics (Generic)+import Ide.Plugin.Error import Ide.Plugin.GHC import Ide.PluginUtils import Ide.Types-import Language.LSP.Server (sendRequest)-import Language.LSP.Types-import qualified Language.LSP.Types.Lens as L+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Message+import Language.LSP.Protocol.Types+import Language.LSP.Server (sendRequest) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) { Ide.Types.pluginHandlers =- mkPluginHandler STextDocumentCodeAction codeActionHandler+ mkPluginHandler SMethod_TextDocumentCodeAction codeActionHandler , pluginCommands = [PluginCommand toGADTSyntaxCommandId "convert data decl to GADT syntax" (toGADTCommand plId)] }@@ -50,54 +57,55 @@ -- | A command replaces H98 data decl with GADT decl in place toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams-toGADTCommand pId@(PluginId pId') state ToGADTParams{..} = pluginResponse $ do- nfp <- getNormalizedFilePath uri+toGADTCommand pId@(PluginId pId') state ToGADTParams{..} = withExceptT handleGhcidePluginError $ do+ nfp <- withExceptT (GhcidePluginErrors) $ getNormalizedFilePathE uri (decls, exts) <- getInRangeH98DeclsAndExts state range nfp (L ann decl) <- case decls of [d] -> pure d- _ -> throwE $ "Expected 1 declaration, but got " <> show (Prelude.length decls)- deps <- liftIO $ runAction (T.unpack pId' <> ".GhcSessionDeps") state $ use GhcSessionDeps nfp- (hsc_dflags . hscEnv -> df) <- liftEither- $ maybeToEither "Get GhcSessionDeps failed" deps- txt <- liftEither $ T.pack <$> (prettyGADTDecl df . h98ToGADTDecl) decl+ _ -> throwError $ UnexpectedNumberOfDeclarations (Prelude.length decls)+ deps <- withExceptT GhcidePluginErrors+ $ runActionE (T.unpack pId' <> ".GhcSessionDeps") state+ $ useE GhcSessionDeps nfp+ (hsc_dflags . hscEnv -> df) <- pure deps+ txt <- withExceptT (PrettyGadtError . T.pack) $ liftEither $ T.pack <$> (prettyGADTDecl df . h98ToGADTDecl) decl range <- liftEither- $ maybeToEither "Unable to get data decl range"+ $ maybeToEither FailedToFindDataDeclRange $ srcSpanToRange $ locA ann- pragma <- getFirstPragma pId state nfp+ pragma <- withExceptT GhcidePluginErrors $ getFirstPragma pId state nfp let insertEdit = [insertNewPragma pragma GADTs | all (`notElem` exts) [GADTSyntax, GADTs]] _ <- lift $ sendRequest- SWorkspaceApplyEdit+ SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing (workSpaceEdit nfp (TextEdit range txt : insertEdit))) (\_ -> pure ()) - pure Null+ pure $ InR Null where workSpaceEdit nfp edits = WorkspaceEdit- (pure $ HashMap.fromList+ (pure $ Map.fromList [(filePathToUri $ fromNormalizedFilePath nfp,- List edits)])+ edits)]) Nothing Nothing -codeActionHandler :: PluginMethodHandler IdeState TextDocumentCodeAction-codeActionHandler state plId (CodeActionParams _ _ doc range _) = pluginResponse $ do- nfp <- getNormalizedFilePath (doc ^. L.uri)+codeActionHandler :: PluginMethodHandler IdeState Method_TextDocumentCodeAction+codeActionHandler state plId (CodeActionParams _ _ doc range _) = withExceptT handleGhcidePluginError $ do+ nfp <- withExceptT (GhcidePluginErrors) $ getNormalizedFilePathE (doc ^. L.uri) (inRangeH98Decls, _) <- getInRangeH98DeclsAndExts state range nfp let actions = map (mkAction . printOutputable . tcdLName . unLoc) inRangeH98Decls- pure $ List actions+ pure $ InL actions where mkAction :: T.Text -> Command |? CodeAction mkAction name = InR CodeAction{..} where _title = "Convert \"" <> name <> "\" to GADT syntax"- _kind = Just CodeActionRefactorRewrite+ _kind = Just CodeActionKind_RefactorRewrite _diagnostics = Nothing _isPreferred = Nothing _disabled = Nothing _edit = Nothing _command = Just $ mkLspCommand plId toGADTSyntaxCommandId _title (Just [toJSON mkParam])- _xdata = Nothing+ _data_ = Nothing mkParam = ToGADTParams (doc ^. L.uri) range @@ -106,15 +114,33 @@ IdeState -> Range -> NormalizedFilePath- -> ExceptT String m ([LTyClDecl GP], [Extension])+ -> ExceptT GadtPluginError m ([LTyClDecl GP], [Extension]) getInRangeH98DeclsAndExts state range nfp = do- pm <- handleMaybeM "Unable to get ParsedModuleWithComments"- $ liftIO- $ runAction "GADT.GetParsedModuleWithComments" state- $ use GetParsedModuleWithComments nfp+ pm <- withExceptT GhcidePluginErrors+ $ runActionE "GADT.GetParsedModuleWithComments" state+ $ useE GetParsedModuleWithComments nfp let (L _ hsDecls) = hsmodDecls <$> pm_parsed_source pm decls = filter isH98DataDecl $ mapMaybe getDataDecl $ filter (inRange range) hsDecls exts = getExtensions pm pure (decls, exts)++data GadtPluginError+ = UnexpectedNumberOfDeclarations Int+ | FailedToFindDataDeclRange+ | PrettyGadtError T.Text+ | GhcidePluginErrors PluginError++handleGhcidePluginError ::+ GadtPluginError ->+ PluginError+handleGhcidePluginError = \case+ UnexpectedNumberOfDeclarations nums -> do+ PluginInternalError $ "Expected one declaration but found: " <> T.pack (show nums)+ FailedToFindDataDeclRange ->+ PluginInternalError $ "Unable to get data decl range"+ PrettyGadtError errMsg ->+ PluginInternalError $ errMsg+ GhcidePluginErrors errors ->+ errors
test/Main.hs view
@@ -74,8 +74,8 @@ isGADTCodeAction CodeAction{..} = case _kind of Nothing -> False Just kind -> case kind of- CodeActionRefactorRewrite -> True- _ -> False+ CodeActionKind_RefactorRewrite -> True+ _ -> False testDataDir :: FilePath testDataDir = "test" </> "testdata"