diff --git a/hls-tactics-plugin.cabal b/hls-tactics-plugin.cabal --- a/hls-tactics-plugin.cabal +++ b/hls-tactics-plugin.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 category: Development name: hls-tactics-plugin -version: 2.0.0.1 +version: 2.1.0.0 synopsis: Wingman plugin for Haskell Language Server description: Please see the README on GitHub at @@ -99,9 +99,9 @@ , ghc-boot-th , ghc-exactprint , ghc-source-gen ^>=0.4.1 - , ghcide == 2.0.0.1 + , ghcide == 2.1.0.0 , hls-graph - , hls-plugin-api == 2.0.0.1 + , hls-plugin-api == 2.1.0.0 , hls-refactor-plugin , hyphenation , lens @@ -185,7 +185,7 @@ , ghcide , hls-plugin-api , hls-tactics-plugin - , hls-test-utils == 2.0.0.1 + , hls-test-utils == 2.1.0.0 , hspec , hspec-expectations , lens diff --git a/new/src/Wingman/LanguageServer.hs b/new/src/Wingman/LanguageServer.hs --- a/new/src/Wingman/LanguageServer.hs +++ b/new/src/Wingman/LanguageServer.hs @@ -64,7 +64,7 @@ import Wingman.Range import Wingman.StaticPlugin (pattern WingmanMetaprogram, pattern MetaprogramSyntax) import Wingman.Types -import Development.IDE.Types.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) +import Ide.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) import qualified Development.IDE.Core.Shake as Shake diff --git a/new/src/Wingman/Metaprogramming/Parser/Documentation.hs b/new/src/Wingman/Metaprogramming/Parser/Documentation.hs --- a/new/src/Wingman/Metaprogramming/Parser/Documentation.hs +++ b/new/src/Wingman/Metaprogramming/Parser/Documentation.hs @@ -7,8 +7,8 @@ import Data.List (sortOn) import Data.String (IsString) import Data.Text (Text) -import Data.Text.Prettyprint.Doc hiding (parens) -import Data.Text.Prettyprint.Doc.Render.String (renderString) +import Prettyprinter hiding (parens) +import Prettyprinter.Render.String (renderString) import Development.IDE.GHC.Compat (OccName) import qualified Text.Megaparsec as P import Wingman.Metaprogramming.Lexer (Parser, identifier, variable, parens) diff --git a/new/src/Wingman/Metaprogramming/ProofState.hs b/new/src/Wingman/Metaprogramming/ProofState.hs --- a/new/src/Wingman/Metaprogramming/ProofState.hs +++ b/new/src/Wingman/Metaprogramming/ProofState.hs @@ -8,8 +8,8 @@ import Data.Bool (bool) import Data.Functor ((<&>)) import qualified Data.Text as T -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Render.Util.Panic +import Prettyprinter +import Prettyprinter.Render.Util.Panic import Language.LSP.Types (sectionSeparator) import Wingman.Judgements (jHypothesis) import Wingman.Types diff --git a/new/src/Wingman/Plugin.hs b/new/src/Wingman/Plugin.hs --- a/new/src/Wingman/Plugin.hs +++ b/new/src/Wingman/Plugin.hs @@ -15,10 +15,10 @@ import qualified Wingman.LanguageServer as WingmanLanguageServer import Wingman.LanguageServer.Metaprogram (hoverProvider) import Wingman.StaticPlugin -import Development.IDE.Types.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) +import Ide.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) data Log - = LogWingmanLanguageServer WingmanLanguageServer.Log + = LogWingmanLanguageServer WingmanLanguageServer.Log | LogExactPrint E.Log deriving Show diff --git a/old/src/Wingman/AbstractLSP.hs b/old/src/Wingman/AbstractLSP.hs --- a/old/src/Wingman/AbstractLSP.hs +++ b/old/src/Wingman/AbstractLSP.hs @@ -1,6 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE RecordWildCards #-} - +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoMonoLocalBinds #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -10,7 +10,8 @@ import Control.Monad (void) import Control.Monad.IO.Class import Control.Monad.Trans (lift) -import Control.Monad.Trans.Maybe (MaybeT, mapMaybeT) +import Control.Monad.Trans.Except (ExceptT(ExceptT)) +import Control.Monad.Trans.Maybe (MaybeT, mapMaybeT, runMaybeT) import qualified Data.Aeson as A import Data.Coerce import Data.Foldable (traverse_) @@ -21,16 +22,20 @@ import Development.IDE (IdeState) import Development.IDE.Core.UseStale import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource(GetAnnotatedParsedSource)) +import Ide.Plugin.Error import qualified Ide.Plugin.Config as Plugin import Ide.Types -import Language.LSP.Server (LspM, sendRequest, getClientCapabilities) -import qualified Language.LSP.Types as LSP -import Language.LSP.Types hiding (CodeLens, CodeAction) +import Language.LSP.Server (LspM, sendRequest, getClientCapabilities, getVersionedTextDoc) +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message +import qualified Language.LSP.Protocol.Types as LSP +import Language.LSP.Protocol.Types hiding (CodeLens, CodeAction) import Wingman.AbstractLSP.Types import Wingman.EmptyCase (fromMaybeT) import Wingman.LanguageServer (runIde, getTacticConfigAction, getIdeDynflags, mkWorkspaceEdits, runStaleIde, showLspMessage, mkShowMessageParams) import Wingman.StaticPlugin (enableQuasiQuotes) import Wingman.Types +import Control.Lens ((^.)) ------------------------------------------------------------------------------ @@ -59,9 +64,9 @@ flip foldMap cs $ \(Interaction (c :: Continuation sort target b)) -> case c_makeCommand c of SynthesizeCodeAction k -> - mkPluginHandler STextDocumentCodeAction $ codeActionProvider @target (c_sort c) k + mkPluginHandler SMethod_TextDocumentCodeAction $ codeActionProvider @target (c_sort c) k SynthesizeCodeLens k -> - mkPluginHandler STextDocumentCodeLens $ codeLensProvider @target (c_sort c) k + mkPluginHandler SMethod_TextDocumentCodeLens $ codeLensProvider @target (c_sort c) k ------------------------------------------------------------------------------ @@ -86,21 +91,17 @@ => PluginId -> Continuation sort a b -> CommandFunction IdeState (FileContext, b) -runContinuation plId cont state (fc, b) = do +runContinuation plId cont state (fc, b) = ExceptT $ do fromMaybeT - (Left $ ResponseError - { _code = InternalError - , _message = T.pack "TODO(sandy)" - , _xdata = Nothing - } ) $ do + (Left $ PluginInternalError "TODO(sandy)") $ do env@LspEnv{..} <- buildEnv state plId fc - nfp <- getNfp $ fc_uri le_fileContext + nfp <- getNfp $ fc_verTxtDocId le_fileContext ^. L.uri let stale a = runStaleIde "runContinuation" state nfp a args <- fetchTargetArgs @a env res <- c_runCommand cont env args fc b -- This block returns a maybe error. - fmap (maybe (Right A.Null) Left . coerce . foldMap Last) $ + fmap (maybe (Right $ InR Null) Left . coerce . foldMap Last) $ for res $ \case ErrorMessages errs -> do traverse_ showUserFacingMessage errs @@ -111,13 +112,9 @@ GraftEdit gr -> do ccs <- lift getClientCapabilities TrackedStale pm _ <- mapMaybeT liftIO $ stale GetAnnotatedParsedSource - case mkWorkspaceEdits (enableQuasiQuotes le_dflags) ccs (fc_uri le_fileContext) (unTrack pm) gr of + case mkWorkspaceEdits (enableQuasiQuotes le_dflags) ccs (fc_verTxtDocId le_fileContext) (unTrack pm) gr of Left errs -> - pure $ Just $ ResponseError - { _code = InternalError - , _message = T.pack $ show errs - , _xdata = Nothing - } + pure $ Just $ PluginInternalError (T.pack $ show errs) Right edits -> do sendEdits edits pure Nothing @@ -129,7 +126,7 @@ sendEdits edits = void $ lift $ sendRequest - SWorkspaceApplyEdit + SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edits) (const $ pure ()) @@ -153,7 +150,7 @@ -> MaybeT (LspM Plugin.Config) LspEnv buildEnv state plId fc = do cfg <- liftIO $ runIde "plugin" "config" state $ getTacticConfigAction plId - nfp <- getNfp $ fc_uri fc + nfp <- getNfp $ fc_verTxtDocId fc ^. L.uri dflags <- mapMaybeT liftIO $ getIdeDynflags state nfp pure $ LspEnv { le_ideState = state @@ -174,20 +171,20 @@ -> TargetArgs target -> MaybeT (LspM Plugin.Config) [(Metadata, b)] ) - -> PluginMethodHandler IdeState TextDocumentCodeAction + -> PluginMethodHandler IdeState Method_TextDocumentCodeAction codeActionProvider sort k state plId - (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do - fromMaybeT (Right $ List []) $ do + (CodeActionParams _ _ docId range _) = do + verTxtDocId <- lift $ getVersionedTextDoc docId + handleMaybeM (PluginInvalidUserState "codeActionProvider") $ runMaybeT $ do let fc = FileContext - { fc_uri = uri + { fc_verTxtDocId = verTxtDocId , fc_range = Just $ unsafeMkCurrent range } env <- buildEnv state plId fc args <- fetchTargetArgs @target env actions <- k env args pure - $ Right - $ List + $ InL $ fmap (InR . uncurry (makeCodeAction plId fc sort)) actions @@ -201,20 +198,20 @@ -> TargetArgs target -> MaybeT (LspM Plugin.Config) [(Range, Metadata, b)] ) - -> PluginMethodHandler IdeState TextDocumentCodeLens + -> PluginMethodHandler IdeState Method_TextDocumentCodeLens codeLensProvider sort k state plId - (CodeLensParams _ _ (TextDocumentIdentifier uri)) = do - fromMaybeT (Right $ List []) $ do + (CodeLensParams _ _ docId) = do + verTxtDocId <- lift $ getVersionedTextDoc docId + handleMaybeM (PluginInvalidUserState "codeLensProvider") $ runMaybeT $ do let fc = FileContext - { fc_uri = uri + { fc_verTxtDocId = verTxtDocId , fc_range = Nothing } env <- buildEnv state plId fc args <- fetchTargetArgs @target env actions <- k env args pure - $ Right - $ List + $ InL $ fmap (uncurry3 $ makeCodeLens plId sort fc) actions @@ -239,7 +236,7 @@ , _disabled = Nothing , _edit = Nothing , _command = Just cmd - , _xdata = Nothing + , _data_ = Nothing } @@ -261,6 +258,6 @@ in LSP.CodeLens { _range = range , _command = Just cmd - , _xdata = Nothing + , _data_ = Nothing } diff --git a/old/src/Wingman/AbstractLSP/TacticActions.hs b/old/src/Wingman/AbstractLSP/TacticActions.hs --- a/old/src/Wingman/AbstractLSP/TacticActions.hs +++ b/old/src/Wingman/AbstractLSP/TacticActions.hs @@ -4,6 +4,7 @@ module Wingman.AbstractLSP.TacticActions where +import Control.Lens ((^.)) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans (lift) @@ -16,6 +17,7 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.ExactPrint import Generics.SYB.GHC (mkBindListT, everywhereM') +import qualified Language.LSP.Protocol.Lens as L import Wingman.AbstractLSP.Types import Wingman.CaseSplit import Wingman.GHC (liftMaybe, isHole, pattern AMatch) @@ -45,7 +47,7 @@ } ) $ \LspEnv{..} HoleJudgment{..} FileContext{..} var_name -> do - nfp <- getNfp fc_uri + nfp <- getNfp (fc_verTxtDocId ^. L.uri) let stale a = runStaleIde "tacticCmd" le_ideState nfp a let span = fmap (rangeToRealSrcSpan (fromNormalizedFilePath nfp)) hj_range diff --git a/old/src/Wingman/AbstractLSP/Types.hs b/old/src/Wingman/AbstractLSP/Types.hs --- a/old/src/Wingman/AbstractLSP/Types.hs +++ b/old/src/Wingman/AbstractLSP/Types.hs @@ -9,6 +9,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Maybe (MaybeT (MaybeT), mapMaybeT) +import Control.Lens ((^.)) import qualified Data.Aeson as A import Data.Text (Text) import Development.IDE (IdeState) @@ -19,7 +20,8 @@ import qualified Ide.Plugin.Config as Plugin import Ide.Types hiding (Config) import Language.LSP.Server (LspM) -import Language.LSP.Types hiding (CodeLens, CodeAction) +import Language.LSP.Protocol.Types hiding (CodeLens, CodeAction) +import qualified Language.LSP.Protocol.Lens as L import Wingman.LanguageServer (judgementForHole) import Wingman.Types @@ -120,12 +122,12 @@ ------------------------------------------------------------------------------ -- | What file are we looking at, and what bit of it? data FileContext = FileContext - { fc_uri :: Uri - , fc_range :: Maybe (Tracked 'Current Range) + { fc_verTxtDocId :: VersionedTextDocumentIdentifier + , fc_range :: Maybe (Tracked 'Current Range) -- ^ For code actions, this is 'Just'. For code lenses, you'll get -- a 'Nothing' in the request, and a 'Just' in the response. } - deriving stock (Eq, Ord, Show, Generic) + deriving stock (Eq, Show, Generic) deriving anyclass (A.ToJSON, A.FromJSON) @@ -164,6 +166,6 @@ fetchTargetArgs LspEnv{..} = do let FileContext{..} = le_fileContext range <- MaybeT $ pure fc_range - nfp <- getNfp fc_uri + nfp <- getNfp (fc_verTxtDocId ^. L.uri) mapMaybeT liftIO $ judgementForHole le_ideState nfp range le_config diff --git a/old/src/Wingman/EmptyCase.hs b/old/src/Wingman/EmptyCase.hs --- a/old/src/Wingman/EmptyCase.hs +++ b/old/src/Wingman/EmptyCase.hs @@ -7,6 +7,7 @@ module Wingman.EmptyCase where import Control.Applicative (empty) +import Control.Lens import Control.Monad import Control.Monad.Except (runExcept) import Control.Monad.Trans @@ -26,7 +27,8 @@ import Development.IDE.Spans.LocalBindings (getLocalScope) import Ide.Types import Language.LSP.Server -import Language.LSP.Types +import Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Types import Prelude hiding (span) import Wingman.AbstractLSP.Types import Wingman.CodeGen (destructionFor) @@ -50,7 +52,7 @@ Continuation @EmptyCaseT @EmptyCaseT @WorkspaceEdit EmptyCaseT (SynthesizeCodeLens $ \LspEnv{..} _ -> do let FileContext{..} = le_fileContext - nfp <- getNfp fc_uri + nfp <- getNfp (fc_verTxtDocId ^. L.uri) let stale a = runStaleIde "codeLensProvider" le_ideState nfp a @@ -69,14 +71,14 @@ (foldMap (hySingleton . occName . fst) bindings) ty edits <- liftMaybe $ hush $ - mkWorkspaceEdits le_dflags ccs fc_uri (unTrack pm) $ + mkWorkspaceEdits le_dflags ccs fc_verTxtDocId (unTrack pm) $ graftMatchGroup (RealSrcSpan (unTrack ss) Nothing) $ noLoc matches pure ( range , Metadata (mkEmptyCaseLensDesc ty) - (CodeActionUnknown "refactor.wingman.completeEmptyCase") + (CodeActionKind_Custom "refactor.wingman.completeEmptyCase") False , edits ) diff --git a/old/src/Wingman/LanguageServer.hs b/old/src/Wingman/LanguageServer.hs --- a/old/src/Wingman/LanguageServer.hs +++ b/old/src/Wingman/LanguageServer.hs @@ -47,11 +47,9 @@ import Ide.Types (PluginId) import Language.Haskell.GHC.ExactPrint (Transform, modifyAnnsT, addAnnotationsForPretty) import Language.LSP.Server (MonadLsp, sendNotification) -import Language.LSP.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length), - SemanticTokensEdit (_start)) -import Language.LSP.Types.Capabilities +import Language.LSP.Protocol.Types hiding + (SemanticTokensEdit (_start)) +import Language.LSP.Protocol.Message import Prelude hiding (span) import Retrie (transformA) import Wingman.Context @@ -62,7 +60,7 @@ import Wingman.Range import Wingman.StaticPlugin (pattern WingmanMetaprogram, pattern MetaprogramSyntax) import Wingman.Types -import Development.IDE.Types.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) +import Ide.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) import qualified Development.IDE.Core.Shake as Shake @@ -172,10 +170,10 @@ "Maximum number of `Use constructor ` code actions that can appear" 5 & defineEnumProperty #hole_severity "The severity to use when showing hole diagnostics. These are noisy, but some editors don't allow jumping to all severities." - [ (Just DsError, "error") - , (Just DsWarning, "warning") - , (Just DsInfo, "info") - , (Just DsHint, "hint") + [ (Just DiagnosticSeverity_Error, "error") + , (Just DiagnosticSeverity_Warning, "warning") + , (Just DiagnosticSeverity_Information, "info") + , (Just DiagnosticSeverity_Hint, "hint") , (Nothing, "none") ] Nothing @@ -521,11 +519,11 @@ ufmSeverity :: UserFacingMessage -> MessageType -ufmSeverity NotEnoughGas = MtInfo -ufmSeverity TacticErrors = MtError -ufmSeverity TimedOut = MtInfo -ufmSeverity NothingToDo = MtInfo -ufmSeverity (InfrastructureError _) = MtError +ufmSeverity NotEnoughGas = MessageType_Info +ufmSeverity TacticErrors = MessageType_Error +ufmSeverity TimedOut = MessageType_Info +ufmSeverity NothingToDo = MessageType_Info +ufmSeverity (InfrastructureError _) = MessageType_Error mkShowMessageParams :: UserFacingMessage -> ShowMessageParams @@ -533,7 +531,7 @@ showLspMessage :: MonadLsp cfg m => ShowMessageParams -> m () -showLspMessage = sendNotification SWindowShowMessage +showLspMessage = sendNotification SMethod_WindowShowMessage -- This rule only exists for generating file diagnostics @@ -610,10 +608,12 @@ Diagnostic r (Just severity) (Just $ InR "hole") + Nothing (Just "wingman") "Hole" - (Just $ List [DtUnnecessary]) + (Just [DiagnosticTag_Unnecessary]) Nothing + Nothing ------------------------------------------------------------------------------ @@ -621,13 +621,13 @@ mkWorkspaceEdits :: DynFlags -> ClientCapabilities - -> Uri + -> VersionedTextDocumentIdentifier -> Annotated ParsedSource -> Graft (Either String) ParsedSource -> Either UserFacingMessage WorkspaceEdit -mkWorkspaceEdits dflags ccs uri pm g = do +mkWorkspaceEdits dflags ccs verTxtDocId pm g = do let pm' = runIdentity $ transformA pm annotateMetaprograms - let response = transform dflags ccs uri g pm' + let response = transform dflags ccs verTxtDocId g pm' in first (InfrastructureError . T.pack) response diff --git a/old/src/Wingman/LanguageServer/Metaprogram.hs b/old/src/Wingman/LanguageServer/Metaprogram.hs --- a/old/src/Wingman/LanguageServer/Metaprogram.hs +++ b/old/src/Wingman/LanguageServer/Metaprogram.hs @@ -20,7 +20,8 @@ import Development.IDE.Core.UseStale import Development.IDE.GHC.Compat hiding (empty) import Ide.Types -import Language.LSP.Types +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message import Prelude hiding (span) import Wingman.LanguageServer import Wingman.Metaprogramming.Parser (attempt_it) @@ -29,31 +30,30 @@ ------------------------------------------------------------------------------ -- | Provide the "empty case completion" code lens -hoverProvider :: PluginMethodHandler IdeState TextDocumentHover +hoverProvider :: PluginMethodHandler IdeState Method_TextDocumentHover hoverProvider state plId (HoverParams (TextDocumentIdentifier uri) (unsafeMkCurrent -> pos) _) | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do let loc = fmap (realSrcLocSpan . positionToRealSrcLoc nfp) pos stale = unsafeRunStaleIdeFast "hoverProvider" state nfp cfg <- liftIO $ runIde "plugin" "config" state (getTacticConfigAction plId) - liftIO $ fromMaybeT (Right Nothing) $ do + liftIO $ fromMaybeT (InR Null) $ do holes <- stale GetMetaprograms - fmap (Right . Just) $ - case find (flip containsSpan (unTrack loc) . unTrack . fst) holes of - Just (trss, program) -> do - let tr_range = fmap realSrcSpanToRange trss - rsl = realSrcSpanStart $ unTrack trss - HoleJudgment{hj_jdg=jdg, hj_ctx=ctx} <- judgementForHole state nfp tr_range cfg - z <- liftIO $ attempt_it rsl ctx jdg $ T.unpack program - pure $ Hover - { _contents = HoverContents - $ MarkupContent MkMarkdown - $ either T.pack T.pack z - , _range = Just $ unTrack tr_range - } - Nothing -> empty -hoverProvider _ _ _ = pure $ Right Nothing + case find (flip containsSpan (unTrack loc) . unTrack . fst) holes of + Just (trss, program) -> do + let tr_range = fmap realSrcSpanToRange trss + rsl = realSrcSpanStart $ unTrack trss + HoleJudgment{hj_jdg=jdg, hj_ctx=ctx} <- judgementForHole state nfp tr_range cfg + z <- liftIO $ attempt_it rsl ctx jdg $ T.unpack program + pure $ InL $ Hover + { _contents = InL + $ MarkupContent MarkupKind_Markdown + $ either T.pack T.pack z + , _range = Just $ unTrack tr_range + } + Nothing -> empty +hoverProvider _ _ _ = pure $ InR Null fromMaybeT :: Functor m => a -> MaybeT m a -> m a fromMaybeT def = fmap (fromMaybe def) . runMaybeT diff --git a/old/src/Wingman/LanguageServer/TacticProviders.hs b/old/src/Wingman/LanguageServer/TacticProviders.hs --- a/old/src/Wingman/LanguageServer/TacticProviders.hs +++ b/old/src/Wingman/LanguageServer/TacticProviders.hs @@ -17,7 +17,7 @@ import qualified Data.Text as T import Development.IDE.GHC.Compat import Ide.Types hiding (Config) -import Language.LSP.Types hiding (SemanticTokenAbsolute (..), SemanticTokenRelative (..)) +import Language.LSP.Protocol.Types import Prelude hiding (span) import Wingman.AbstractLSP.Types import Wingman.Auto @@ -86,7 +86,7 @@ mkTacticKind :: TacticCommand -> CodeActionKind mkTacticKind = - CodeActionUnknown . mappend "refactor.wingman." . tacticKind + CodeActionKind_Custom . mappend "refactor.wingman." . tacticKind ------------------------------------------------------------------------------ diff --git a/old/src/Wingman/Metaprogramming/Parser/Documentation.hs b/old/src/Wingman/Metaprogramming/Parser/Documentation.hs --- a/old/src/Wingman/Metaprogramming/Parser/Documentation.hs +++ b/old/src/Wingman/Metaprogramming/Parser/Documentation.hs @@ -7,8 +7,8 @@ import Data.List (sortOn) import Data.String (IsString) import Data.Text (Text) -import Data.Text.Prettyprint.Doc hiding (parens) -import Data.Text.Prettyprint.Doc.Render.String (renderString) +import Prettyprinter hiding (parens) +import Prettyprinter.Render.String (renderString) import Development.IDE.GHC.Compat (OccName) import qualified Text.Megaparsec as P import Wingman.Metaprogramming.Lexer (Parser, identifier, variable, parens) diff --git a/old/src/Wingman/Metaprogramming/ProofState.hs b/old/src/Wingman/Metaprogramming/ProofState.hs --- a/old/src/Wingman/Metaprogramming/ProofState.hs +++ b/old/src/Wingman/Metaprogramming/ProofState.hs @@ -8,9 +8,9 @@ import Data.Bool (bool) import Data.Functor ((<&>)) import qualified Data.Text as T -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Render.Util.Panic -import Language.LSP.Types (sectionSeparator) +import Prettyprinter +import Prettyprinter.Render.Util.Panic +import Language.LSP.Protocol.Types (sectionSeparator) import Wingman.Judgements (jHypothesis) import Wingman.Types diff --git a/old/src/Wingman/Plugin.hs b/old/src/Wingman/Plugin.hs --- a/old/src/Wingman/Plugin.hs +++ b/old/src/Wingman/Plugin.hs @@ -6,7 +6,7 @@ import Development.IDE.Plugin.CodeAction import qualified Development.IDE.GHC.ExactPrint as E import Ide.Types -import Language.LSP.Types +import Language.LSP.Protocol.Message import Prelude hiding (span) import Wingman.AbstractLSP import Wingman.AbstractLSP.TacticActions (makeTacticInteraction) @@ -15,10 +15,10 @@ import qualified Wingman.LanguageServer as WingmanLanguageServer import Wingman.LanguageServer.Metaprogram (hoverProvider) import Wingman.StaticPlugin -import Development.IDE.Types.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) +import Ide.Logger (Recorder, cmapWithPrio, WithPriority, Pretty (pretty)) data Log - = LogWingmanLanguageServer WingmanLanguageServer.Log + = LogWingmanLanguageServer WingmanLanguageServer.Log | LogExactPrint E.Log deriving Show @@ -35,7 +35,7 @@ : fmap makeTacticInteraction [minBound .. maxBound] ) $ (defaultPluginDescriptor plId) - { pluginHandlers = mkPluginHandler STextDocumentHover hoverProvider + { pluginHandlers = mkPluginHandler SMethod_TextDocumentHover hoverProvider , pluginRules = wingmanRules (cmapWithPrio LogWingmanLanguageServer recorder) plId , pluginConfigDescriptor = defaultConfigDescriptor diff --git a/old/test/Utils.hs b/old/test/Utils.hs --- a/old/test/Utils.hs +++ b/old/test/Utils.hs @@ -23,9 +23,9 @@ import qualified Data.Text.IO as T import Ide.Plugin.Tactic as Tactic import Ide.Types (IdePlugins(..)) -import Language.LSP.Types -import Language.LSP.Types.Lens hiding (actions, applyEdit, capabilities, executeCommand, id, line, message, name, rename, title) -import qualified Language.LSP.Types.Lens as J +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Lens hiding (actions, applyEdit, capabilities, executeCommand, id, line, message, name, rename, title, error) import System.Directory (doesFileExist) import System.FilePath import Test.Hls @@ -87,19 +87,20 @@ -> SpecWith (Arg Bool) mkTest name fp line col ts = it name $ do resetGlobalHoleRef - runSessionForTactics $ do + actions <- E.handle (\(UnexpectedResponseError _ _) -> pure []) + $ runSessionForTactics $ do doc <- openDoc (fp <.> "hs") "haskell" -- wait for diagnostics to start coming void waitForDiagnostics -- wait for the entire build to finish, so that Tactics code actions that -- use stale data will get uptodate stuff void $ waitForTypecheck doc - actions <- getCodeActions doc $ pointRange line col - let titles = mapMaybe codeActionTitle actions - for_ ts $ \(f, tc, var) -> do - let title = tacticTitle tc var - liftIO $ - (title `elem` titles) `shouldSatisfy` f + getCodeActions doc $ pointRange line col + let titles = mapMaybe codeActionTitle actions + for_ ts $ \(f, tc, var) -> do + let title = tacticTitle tc var + liftIO $ + (title `elem` titles) `shouldSatisfy` f data InvokeTactic = InvokeTactic { it_command :: TacticCommand @@ -118,7 +119,7 @@ case find ((== Just (tacticTitle it_command it_argument)) . codeActionTitle) actions of Just (InR CodeAction {_command = Just c}) -> do executeCommand c - void $ skipManyTill anyMessage $ message SWorkspaceApplyEdit + void $ skipManyTill anyMessage $ message SMethod_WorkspaceApplyEdit _ -> error $ show actions @@ -154,7 +155,7 @@ lenses <- fmap (reverse . filter isWingmanLens) $ getCodeLenses doc for_ lenses $ \(CodeLens _ (Just cmd) _) -> executeCommand cmd - _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) + _resp <- skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) edited <- documentContents doc let expected_name = input <.> "expected" <.> "hs" -- Write golden tests if they don't already exist @@ -204,7 +205,7 @@ Just (InR CodeAction {_command = Just c}) <- pure $ find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions executeCommand c - NotificationMessage _ _ err <- skipManyTill anyMessage (message SWindowShowMessage) + TNotificationMessage _ _ err <- skipManyTill anyMessage (message SMethod_WindowShowMessage) liftIO $ err `shouldBe` mkShowMessageParams ufm @@ -258,9 +259,9 @@ tacticPath = "old/test/golden" -executeCommandWithResp :: Command -> Session (ResponseMessage 'WorkspaceExecuteCommand) +executeCommandWithResp :: Command -> Session (TResponseMessage 'Method_WorkspaceExecuteCommand) executeCommandWithResp cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments execParams = ExecuteCommandParams Nothing (cmd ^. command) args - request SWorkspaceExecuteCommand execParams + request SMethod_WorkspaceExecuteCommand execParams