hls-class-plugin 2.0.0.1 → 2.1.0.0
raw patch · 8 files changed
+152/−137 lines, 8 filesdep +mtldep +row-typesdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependencies added: mtl, row-types
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-class-plugin.cabal +6/−4
- src/Ide/Plugin/Class.hs +5/−5
- src/Ide/Plugin/Class/CodeAction.hs +60/−68
- src/Ide/Plugin/Class/CodeLens.hs +21/−24
- src/Ide/Plugin/Class/ExactPrint.hs +3/−3
- src/Ide/Plugin/Class/Types.hs +3/−3
- src/Ide/Plugin/Class/Utils.hs +16/−19
- test/Main.hs +38/−11
hls-class-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-class-plugin-version: 2.0.0.1+version: 2.1.0.0 synopsis: Class/instance management plugin for Haskell Language Server @@ -39,12 +39,13 @@ , deepseq , extra , ghc- , ghcide == 2.0.0.1+ , ghcide == 2.1.0.0 , ghc-boot-th , hls-graph- , hls-plugin-api == 2.0.0.1+ , hls-plugin-api == 2.1.0.0 , lens , lsp+ , mtl , text , transformers @@ -74,7 +75,8 @@ , ghcide , hls-class-plugin , hls-plugin-api- , hls-test-utils == 2.0.0.1+ , hls-test-utils == 2.1.0.0 , lens , lsp-types+ , row-types , text
src/Ide/Plugin/Class.hs view
@@ -1,18 +1,18 @@ module Ide.Plugin.Class (descriptor, Log(..)) where -import Development.IDE (IdeState, Recorder, WithPriority)+import Development.IDE (IdeState, Recorder,+ WithPriority) import Ide.Plugin.Class.CodeAction import Ide.Plugin.Class.CodeLens import Ide.Plugin.Class.Types import Ide.Types-import Language.LSP.Types-+import Language.LSP.Protocol.Message descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId) { pluginCommands = commands plId , pluginRules = rules recorder- , pluginHandlers = mkPluginHandler STextDocumentCodeAction (codeAction recorder)- <> mkPluginHandler STextDocumentCodeLens codeLens+ , pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeAction recorder)+ <> mkPluginHandler SMethod_TextDocumentCodeLens codeLens } commands :: PluginId -> [PluginCommand IdeState]
src/Ide/Plugin/Class/CodeAction.hs view
@@ -5,14 +5,14 @@ module Ide.Plugin.Class.CodeAction where -import Control.Applicative (liftA2) import Control.Lens hiding (List, use)+import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Extra import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Except (ExceptT, throwE)+import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Maybe-import Data.Aeson+import Data.Aeson hiding (Null) import Data.Bifunctor (second) import Data.Either.Extra (rights) import Data.List@@ -23,94 +23,89 @@ import qualified Data.Set as Set import qualified Data.Text as T import Development.IDE+import Development.IDE.Core.Compile (sourceTypecheck)+import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (fromCurrentRange) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import Development.IDE.Spans.AtPoint (pointCommand)-import GHC.LanguageExtensions.Type import Ide.Plugin.Class.ExactPrint import Ide.Plugin.Class.Types import Ide.Plugin.Class.Utils import qualified Ide.Plugin.Config+import Ide.Plugin.Error import Ide.PluginUtils import Ide.Types+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Message+import Language.LSP.Protocol.Types import Language.LSP.Server-import Language.LSP.Types-import qualified Language.LSP.Types.Lens as J addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do- caps <- getClientCapabilities- pluginResponse $ do- nfp <- getNormalizedFilePath uri- pm <- handleMaybeM "Unable to GetParsedModule"- $ liftIO- $ runAction "classplugin.addMethodPlaceholders.GetParsedModule" state- $ use GetParsedModule nfp- (hsc_dflags . hscEnv -> df) <- handleMaybeM "Unable to GhcSessionDeps"- $ liftIO- $ runAction "classplugin.addMethodPlaceholders.GhcSessionDeps" state- $ use GhcSessionDeps nfp- (old, new) <- handleMaybeM "Unable to makeEditText"- $ liftIO $ runMaybeT- $ makeEditText pm df param- pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs- let edit =- if withSig- then mergeEdit (workspaceEdit caps old new) pragmaInsertion- else workspaceEdit caps old new+ caps <- lift $ getClientCapabilities+ nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri)+ pm <- runActionE "classplugin.addMethodPlaceholders.GetParsedModule" state+ $ useE GetParsedModule nfp+ (hsc_dflags . hscEnv -> df) <- runActionE "classplugin.addMethodPlaceholders.GhcSessionDeps" state+ $ useE GhcSessionDeps nfp+ (old, new) <- handleMaybeM (PluginInternalError "Unable to makeEditText")+ $ liftIO $ runMaybeT+ $ makeEditText pm df param+ pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs+ let edit =+ if withSig+ then mergeEdit (workspaceEdit caps old new) pragmaInsertion+ else workspaceEdit caps old new - void $ lift $ sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())+ void $ lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ()) - pure Null+ pure $ InR Null where toTextDocumentEdit edit =- TextDocumentEdit (VersionedTextDocumentIdentifier uri (Just 0)) (List [InL edit])+ TextDocumentEdit (verTxtDocId ^.re _versionedTextDocumentIdentifier) [InL edit] mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit mergeEdit WorkspaceEdit{..} edits = WorkspaceEdit { _documentChanges =- (\(List x) -> List $ x ++ map (InL . toTextDocumentEdit) edits)+ (\x -> x ++ map (InL . toTextDocumentEdit) edits) <$> _documentChanges , .. } workspaceEdit caps old new- = diffText caps (uri, old) new IncludeDeletions+ = diffText caps (verTxtDocId, old) new IncludeDeletions -- | -- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is -- sensitive to the format of diagnostic messages from GHC.-codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState TextDocumentCodeAction-codeAction recorder state plId (CodeActionParams _ _ docId _ context) = pluginResponse $ do- nfp <- getNormalizedFilePath uri- actions <- join <$> mapM (mkActions nfp) methodDiags- pure $ List actions+codeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction+codeAction recorder state plId (CodeActionParams _ _ docId _ context) = do+ verTxtDocId <- lift $ getVersionedTextDoc docId+ nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri)+ actions <- join <$> mapM (mkActions nfp verTxtDocId) methodDiags+ pure $ InL actions where- uri = docId ^. J.uri- List diags = context ^. J.diagnostics+ diags = context ^. L.diagnostics - ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags- methodDiags = filter (\d -> isClassMethodWarning (d ^. J.message)) ghcDiags+ ghcDiags = filter (\d -> d ^. L.source == Just sourceTypecheck) diags+ methodDiags = filter (\d -> isClassMethodWarning (d ^. L.message)) ghcDiags mkActions :: NormalizedFilePath+ -> VersionedTextDocumentIdentifier -> Diagnostic- -> ExceptT String (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction]- mkActions docPath diag = do- (HAR {hieAst = ast}, pmap) <- handleMaybeM "Unable to GetHieAst"- . liftIO- . runAction "classplugin.findClassIdentifier.GetHieAst" state- $ useWithStale GetHieAst docPath- instancePosition <- handleMaybe "No range" $- fromCurrentRange pmap range ^? _Just . J.start- & fmap (J.character -~ 1)+ -> ExceptT PluginError (LspT Ide.Plugin.Config.Config IO) [Command |? CodeAction]+ mkActions docPath verTxtDocId diag = do+ (HAR {hieAst = ast}, pmap) <- runActionE "classplugin.findClassIdentifier.GetHieAst" state+ $ useWithStaleE GetHieAst docPath+ instancePosition <- handleMaybe (PluginInvalidUserState "fromCurrentRange") $+ fromCurrentRange pmap range ^? _Just . L.start+ & fmap (L.character -~ 1) ident <- findClassIdentifier ast instancePosition cls <- findClassFromIdentifier docPath ident- InstanceBindTypeSigsResult sigs <- handleMaybeM "Unable to GetInstanceBindTypeSigs"- $ liftIO- $ runAction "classplugin.codeAction.GetInstanceBindTypeSigs" state- $ use GetInstanceBindTypeSigs docPath+ InstanceBindTypeSigsResult sigs <- runActionE "classplugin.codeAction.GetInstanceBindTypeSigs" state+ $ useE GetInstanceBindTypeSigs docPath implemented <- findImplementedMethods ast instancePosition logWith recorder Info (LogImplementedMethods cls implemented) pure@@ -120,7 +115,7 @@ $ fmap (second (filter (\(bind, _) -> bind `notElem` implemented))) $ mkMethodGroups range sigs cls where- range = diag ^. J.range+ range = diag ^. L.range mkMethodGroups :: Range -> [InstanceBindTypeSig] -> Class -> [MethodGroup] mkMethodGroups range sigs cls = minimalDef <> [allClassMethods]@@ -141,15 +136,16 @@ title = "Add placeholders for " <> name titleWithSig = title <> " with signature(s)" + mkCmdParams :: [(T.Text, T.Text)] -> Bool -> [Value] mkCmdParams methodGroup withSig =- [toJSON (AddMinimalMethodsParams uri range (List methodGroup) withSig)]+ [toJSON (AddMinimalMethodsParams verTxtDocId range methodGroup withSig)] mkCodeAction title cmd = InR $ CodeAction title- (Just CodeActionQuickFix)- (Just (List []))+ (Just CodeActionKind_QuickFix)+ (Just []) Nothing Nothing Nothing@@ -157,7 +153,7 @@ Nothing findClassIdentifier hf instancePosition =- handleMaybe "No Identifier found"+ handleMaybe (PluginInternalError "No Identifier found") $ listToMaybe $ mapMaybe listToMaybe $ pointCommand hf instancePosition@@ -168,7 +164,7 @@ findImplementedMethods :: HieASTs a -> Position- -> ExceptT String (LspT Ide.Plugin.Config.Config IO) [T.Text]+ -> ExceptT PluginError (LspT Ide.Plugin.Config.Config IO) [T.Text] findImplementedMethods asts instancePosition = do pure $ concat@@ -185,15 +181,11 @@ in valBindIds <> concatMap findInstanceValBindIdentifiers (nodeChildren ast) findClassFromIdentifier docPath (Right name) = do- (hscEnv -> hscenv, _) <- handleMaybeM "Unable to GhcSessionDeps"- . liftIO- . runAction "classplugin.findClassFromIdentifier.GhcSessionDeps" state- $ useWithStale GhcSessionDeps docPath- (tmrTypechecked -> thisMod, _) <- handleMaybeM "Unable to TypeCheck"- . liftIO- . runAction "classplugin.findClassFromIdentifier.TypeCheck" state- $ useWithStale TypeCheck docPath- handleMaybeM "TcEnv"+ (hscEnv -> hscenv, _) <- runActionE "classplugin.findClassFromIdentifier.GhcSessionDeps" state+ $ useWithStaleE GhcSessionDeps docPath+ (tmrTypechecked -> thisMod, _) <- runActionE "classplugin.findClassFromIdentifier.TypeCheck" state+ $ useWithStaleE TypeCheck docPath+ handleMaybeM (PluginInternalError "initTcWithGbl failed") . liftIO . fmap snd . initTcWithGbl hscenv thisMod ghostSpan $ do@@ -202,7 +194,7 @@ AGlobal (AConLike (RealDataCon con)) | Just cls <- tyConClass_maybe (dataConOrigTyCon con) -> pure cls _ -> fail "Ide.Plugin.Class.findClassFromIdentifier"- findClassFromIdentifier _ (Left _) = throwE "Ide.Plugin.Class.findClassIdentifier"+ findClassFromIdentifier _ (Left _) = throwError (PluginInternalError "Ide.Plugin.Class.findClassIdentifier") isClassNodeIdentifier :: IdentifierDetails a -> Bool isClassNodeIdentifier ident = (isNothing . identType) ident && Use `Set.member` identInfo ident
src/Ide/Plugin/Class/CodeLens.hs view
@@ -6,41 +6,38 @@ module Ide.Plugin.Class.CodeLens where import Control.Lens ((^.))-import Control.Monad.IO.Class (liftIO)-import Data.Aeson+import Control.Monad.Trans.Class (MonadTrans (lift))+import Data.Aeson hiding (Null) import Data.Maybe (mapMaybe, maybeToList) import qualified Data.Text as T import Development.IDE+import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util-import GHC.LanguageExtensions.Type import Ide.Plugin.Class.Types import Ide.Plugin.Class.Utils+import Ide.Plugin.Error import Ide.PluginUtils import Ide.Types+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Message+import Language.LSP.Protocol.Types import Language.LSP.Server (sendRequest)-import Language.LSP.Types-import qualified Language.LSP.Types.Lens as J -codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens-codeLens state plId CodeLensParams{..} = pluginResponse $ do- nfp <- getNormalizedFilePath uri- (tmr, _) <- handleMaybeM "Unable to typecheck"- $ liftIO- $ runAction "classplugin.TypeCheck" state+codeLens :: PluginMethodHandler IdeState Method_TextDocumentCodeLens+codeLens state plId CodeLensParams{..} = do+ nfp <- getNormalizedFilePathE uri+ (tmr, _) <- runActionE "classplugin.TypeCheck" state -- Using stale results means that we can almost always return a value. In practice -- this means the lenses don't 'flicker'- $ useWithStale TypeCheck nfp+ $ useWithStaleE TypeCheck nfp -- All instance binds- (InstanceBindTypeSigsResult allBinds, mp) <-- handleMaybeM "Unable to get InstanceBindTypeSigsResult"- $ liftIO- $ runAction "classplugin.GetInstanceBindTypeSigs" state+ (InstanceBindTypeSigsResult allBinds, mp) <- runActionE "classplugin.GetInstanceBindTypeSigs" state -- Using stale results means that we can almost always return a value. In practice -- this means the lenses don't 'flicker'- $ useWithStale GetInstanceBindTypeSigs nfp+ $ useWithStaleE GetInstanceBindTypeSigs nfp pragmaInsertion <- insertPragmaIfNotPresent state nfp InstanceSigs @@ -60,9 +57,9 @@ $ makeEdit range title mp codeLens = makeLens <$> mapMaybe getRangeWithSig targetSigs - pure $ List codeLens+ pure $ InL codeLens where- uri = _textDocument ^. J.uri+ uri = _textDocument ^. L.uri -- Match Binds with their signatures -- We try to give every `InstanceBindTypeSig` a `SrcSpan`,@@ -121,7 +118,7 @@ workspaceEdit pragmaInsertion edits = WorkspaceEdit- (pure [(uri, List $ edits ++ pragmaInsertion)])+ (pure [(uri, edits ++ pragmaInsertion)]) Nothing Nothing @@ -132,8 +129,8 @@ makeEdit :: Range -> T.Text -> PositionMapping -> [TextEdit] makeEdit range bind mp =- let startPos = range ^. J.start- insertChar = startPos ^. J.character+ let startPos = range ^. L.start+ insertChar = startPos ^. L.character insertRange = Range startPos startPos in case toCurrentRange mp insertRange of Just rg -> [TextEdit rg (bind <> "\n" <> T.replicate (fromIntegral insertChar) " ")]@@ -141,5 +138,5 @@ codeLensCommandHandler :: CommandFunction IdeState WorkspaceEdit codeLensCommandHandler _ wedit = do- _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())- return $ Right Null+ _ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())+ pure $ InR Null
src/Ide/Plugin/Class/ExactPrint.hs view
@@ -12,7 +12,6 @@ import Ide.Plugin.Class.Utils import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers-import Language.LSP.Types #if MIN_VERSION_ghc(9,2,0) import Data.Either.Extra (eitherToMaybe)@@ -22,13 +21,14 @@ import qualified Data.Map.Strict as Map import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs) import Language.Haskell.GHC.ExactPrint.Utils (rs)+import Language.LSP.Protocol.Types (Range) #endif makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text) -- addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located HsModule) #if MIN_VERSION_ghc(9,2,0) makeEditText pm df AddMinimalMethodsParams{..} = do- List mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup+ mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup let ps = makeDeltaAst $ pm_parsed_source pm old = T.pack $ exactPrint ps (ps', _, _) = runTransform (addMethodDecls ps mDecls range withSig)@@ -76,7 +76,7 @@ #else makeEditText pm df AddMinimalMethodsParams{..} = do- List (unzip -> (mAnns, mDecls)) <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup+ (unzip -> (mAnns, mDecls)) <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup let ps = pm_parsed_source pm anns = relativiseApiAnns ps (pm_annotations pm) old = T.pack $ exactPrint ps anns
src/Ide/Plugin/Class/Types.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE BangPatterns #-} module Ide.Plugin.Class.Types where @@ -21,6 +20,7 @@ import GHC.Generics import Ide.Plugin.Class.Utils import Ide.Types+import Language.LSP.Protocol.Types (VersionedTextDocumentIdentifier) typeLensCommandId :: CommandId typeLensCommandId = "classplugin.typelens"@@ -33,9 +33,9 @@ defaultIndent = 2 data AddMinimalMethodsParams = AddMinimalMethodsParams- { uri :: Uri+ { verTxtDocId :: VersionedTextDocumentIdentifier , range :: Range- , methodGroup :: List (T.Text, T.Text)+ , methodGroup :: [(T.Text, T.Text)] -- ^ (name text, signature text) , withSig :: Bool }
src/Ide/Plugin/Class/Utils.hs view
@@ -2,19 +2,21 @@ module Ide.Plugin.Class.Utils where -import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Except-import Data.Char (isAlpha)-import Data.List (isPrefixOf)-import Data.String (IsString)-import qualified Data.Text as T+import Data.Char (isAlpha)+import Data.List (isPrefixOf)+import Data.String (IsString)+import qualified Data.Text as T import Development.IDE+import Development.IDE.Core.PluginUtils import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util-import Development.IDE.Spans.Pragmas (getNextPragmaInfo,- insertNewPragma)+import Development.IDE.Spans.Pragmas (getNextPragmaInfo,+ insertNewPragma)+import Ide.Plugin.Error import Ide.PluginUtils-import Language.LSP.Types+import Language.LSP.Protocol.Types -- | All instance bindings are started with `$c` bindingPrefix :: IsString s => s@@ -54,19 +56,14 @@ => IdeState -> NormalizedFilePath -> Extension- -> ExceptT String m [TextEdit]+ -> ExceptT PluginError m [TextEdit] insertPragmaIfNotPresent state nfp pragma = do- (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- handleMaybeM "Unable to get GhcSession"- $ liftIO- $ runAction "classplugin.insertPragmaIfNotPresent.GhcSession" state- $ useWithStale GhcSession nfp- (_, fileContents) <- liftIO- $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state+ (hscEnv -> hsc_dflags -> sessionDynFlags, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GhcSession" state+ $ useWithStaleE GhcSession nfp+ (_, fileContents) <- liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetFileContents" state $ getFileContents nfp- (pm, _) <- handleMaybeM "Unable to GetParsedModuleWithComments"- $ liftIO- $ runAction "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state- $ useWithStale GetParsedModuleWithComments nfp+ (pm, _) <- runActionE "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state+ $ useWithStaleE GetParsedModuleWithComments nfp let exts = getExtensions pm info = getNextPragmaInfo sessionDynFlags fileContents pure [insertNewPragma info pragma | pragma `notElem` exts]
test/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-}@@ -9,12 +10,16 @@ ( main ) where -import Control.Lens (Prism', prism', (^.), (^..), (^?))-import Control.Monad (void)+import Control.Lens (Prism', prism', (^.), (^..),+ (^?))+import Control.Monad (void) import Data.Maybe-import qualified Data.Text as T-import qualified Ide.Plugin.Class as Class-import qualified Language.LSP.Types.Lens as J+import Data.Row ((.==))+import qualified Data.Text as T+import Development.IDE.Core.Compile (sourceTypecheck)+import qualified Ide.Plugin.Class as Class+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Message import System.FilePath import Test.Hls @@ -76,6 +81,28 @@ [ "Add placeholders for 'f','g'" , "Add placeholders for 'f','g' with signature(s)" ]+ , testCase "Update text document version" $ runSessionWithServer classPlugin testDataDir $ do+ doc <- createDoc "Version.hs" "haskell" "module Version where"+ ver1 <- (^. L.version) <$> getVersionedDoc doc+ liftIO $ ver1 @?= 0++ -- Change the doc to ensure the version is not 0+ changeDoc doc+ [ TextDocumentContentChangeEvent . InR . (.==) #text $+ T.unlines ["module Version where", "data A a = A a", "instance Functor A where"]+ ]+ ver2 <- (^. L.version) <$> getVersionedDoc doc+ _ <- waitForDiagnostics+ liftIO $ ver2 @?= 1++ -- Execute the action and see what the version is+ action <- head . concatMap (^.. _CACodeAction) <$> getAllCodeActions doc+ executeCodeAction action+ _ <- waitForDiagnostics+ -- TODO: uncomment this after lsp-test fixed+ -- ver3 <- (^.J.version) <$> getVersionedDoc doc+ -- liftIO $ ver3 @?= Just 3+ pure mempty ] codeLensTests :: TestTree@@ -85,7 +112,7 @@ runSessionWithServer classPlugin testDataDir $ do doc <- openDoc "CodeLensSimple.hs" "haskell" lens <- getCodeLenses doc- let titles = map (^. J.title) $ mapMaybe (^. J.command) lens+ let titles = map (^. L.title) $ mapMaybe (^. L.command) lens liftIO $ titles @?= [ "(==) :: B -> B -> Bool" , "(==) :: A -> A -> Bool"@@ -122,13 +149,13 @@ goldenCodeLens title path idx = goldenWithHaskellDoc classPlugin title testDataDir path "expected" "hs" $ \doc -> do lens <- getCodeLenses doc- executeCommand $ fromJust $ (lens !! idx) ^. J.command- void $ skipManyTill anyMessage (message SWorkspaceApplyEdit)+ executeCommand $ fromJust $ (lens !! idx) ^. L.command+ void $ skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit) goldenWithClass ::TestName -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree goldenWithClass title path desc act = goldenWithHaskellDoc classPlugin title testDataDir path (desc <.> "expected") "hs" $ \doc -> do- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc act actions void $ skipManyTill anyMessage (getDocumentEdit doc)@@ -138,9 +165,9 @@ testCase title $ do runSessionWithServer classPlugin testDataDir $ do doc <- openDoc (path <.> "hs") "haskell"- _ <- waitForDiagnosticsFromSource doc "typecheck"+ _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck) caResults <- getAllCodeActions doc- liftIO $ map (^? _CACodeAction . J.title) caResults+ liftIO $ map (^? _CACodeAction . L.title) caResults @?= expectedActions where expectedActions = Just <$> actionTitles