hls-class-plugin 1.1.0.0 → 1.1.1.0
raw patch · 5 files changed
+61/−73 lines, 5 filesdep ~ghc-exactprintdep ~ghcidedep ~hls-plugin-apiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghc-exactprint, ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-class-plugin.cabal +10/−14
- src/Ide/Plugin/Class/CodeAction.hs +3/−3
- src/Ide/Plugin/Class/Types.hs +3/−2
- src/Ide/Plugin/Class/Utils.hs +1/−2
- test/Main.hs +44/−52
hls-class-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-class-plugin-version: 1.1.0.0+version: 1.1.1.0 synopsis: Class/instance management plugin for Haskell Language Server @@ -20,11 +20,11 @@ LICENSE test/testdata/*.hs +source-repository head+ type: git+ location: https://github.com/haskell/haskell-language-server.git+ library- if impl(ghc >= 9.3)- buildable: False- else- buildable: True exposed-modules: Ide.Plugin.Class other-modules: Ide.Plugin.Class.CodeAction , Ide.Plugin.Class.CodeLens@@ -39,19 +39,19 @@ , deepseq , extra , ghc- , ghcide ^>=1.8+ , ghcide ^>=1.9 , ghc-boot-th , hls-graph- , hls-plugin-api ^>=1.5+ , hls-plugin-api ^>=1.6 , lens , lsp , text , transformers if impl(ghc >=9.2.1)- build-depends: ghc-exactprint ^>= 1.5+ build-depends: ghc-exactprint >= 1.5 else- build-depends: ghc-exactprint >= 0.6.4 && <1.1+ build-depends: ghc-exactprint >= 0.6.4 && <1.1 default-language: Haskell2010 default-extensions:@@ -62,10 +62,6 @@ ghc-options: -Wall -Wno-unticked-promoted-constructors -Wno-name-shadowing test-suite tests- if impl(ghc >= 9.3)- buildable: False- else- buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test@@ -78,6 +74,6 @@ , ghcide , hls-class-plugin , hls-plugin-api- , hls-test-utils ^>=1.4+ , hls-test-utils ^>=1.5 , lens , lsp-types
src/Ide/Plugin/Class/CodeAction.hs view
@@ -62,13 +62,13 @@ pure Null where- toTextDocunemtEdit edit =+ toTextDocumentEdit edit = TextDocumentEdit (VersionedTextDocumentIdentifier uri (Just 0)) (List [InL edit]) mergeEdit :: WorkspaceEdit -> [TextEdit] -> WorkspaceEdit mergeEdit WorkspaceEdit{..} edits = WorkspaceEdit { _documentChanges =- (\(List x) -> List $ x ++ map (InL . toTextDocunemtEdit) edits)+ (\(List x) -> List $ x ++ map (InL . toTextDocumentEdit) edits) <$> _documentChanges , .. }@@ -190,7 +190,7 @@ . liftIO . runAction "classplugin.findClassFromIdentifier.TypeCheck" state $ useWithStale TypeCheck docPath- handleMaybeM "Error in TcEnv"+ handleMaybeM "TcEnv" . liftIO . fmap snd . initTcWithGbl hscenv thisMod ghostSpan $ do
src/Ide/Plugin/Class/Types.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE BangPatterns #-} module Ide.Plugin.Class.Types where @@ -45,7 +46,7 @@ data InstanceBindTypeSig = InstanceBindTypeSig { bindName :: Name- , bindRendered :: T.Text+ , bindRendered :: !T.Text , bindDefSpan :: Maybe SrcSpan -- ^SrcSpan for the bind definition }@@ -68,7 +69,7 @@ instance Pretty Log where pretty = \case LogImplementedMethods cls methods ->- pretty ("Detected implmented methods for class" :: String)+ pretty ("Detected implemented methods for class" :: String) <+> pretty (show (getOccString cls) <> ":") -- 'show' is used here to add quotes around the class name <+> pretty methods LogShake log -> pretty log
src/Ide/Plugin/Class/Utils.hs view
@@ -13,7 +13,6 @@ import Development.IDE.GHC.Compat.Util import Development.IDE.Spans.Pragmas (getNextPragmaInfo, insertNewPragma)-import GHC.LanguageExtensions.Type (Extension) import Ide.PluginUtils import Language.LSP.Types @@ -64,6 +63,6 @@ $ liftIO $ runAction "classplugin.insertPragmaIfNotPresent.GetParsedModuleWithComments" state $ use GetParsedModuleWithComments nfp- let exts = (toList . extensionFlags . ms_hspp_opts . pm_mod_summary) pm+ let exts = getExtensions pm info = getNextPragmaInfo sessionDynFlags fileContents pure [insertNewPragma info pragma | pragma `notElem` exts]
test/Main.hs view
@@ -9,38 +9,30 @@ ( main ) where -import Control.Lens (Prism', prism', (^.), (^..),- (^?))-import Control.Monad (void)-import Data.Aeson (toJSON, (.=))-import Data.Functor.Contravariant (contramap)+import Control.Lens (Prism', prism', (^.), (^..), (^?))+import Control.Monad (void) import Data.Maybe-import Development.IDE.Types.Logger-import qualified Ide.Plugin.Class as Class-import Ide.Plugin.Config (PluginConfig (plcConfig))-import qualified Ide.Plugin.Config as Plugin-import qualified Language.LSP.Types.Lens as J+import qualified Ide.Plugin.Class as Class+import qualified Language.LSP.Types.Lens as J import System.FilePath import Test.Hls main :: IO ()-main = do- recorder <- makeDefaultStderrRecorder Nothing Debug- defaultTestRunner . tests $ contramap (fmap pretty) recorder+main = defaultTestRunner tests -classPlugin :: Recorder (WithPriority Class.Log) -> PluginDescriptor IdeState-classPlugin recorder = Class.descriptor recorder "class"+classPlugin :: PluginTestDescriptor Class.Log+classPlugin = mkPluginTestDescriptor Class.descriptor "class" -tests :: Recorder (WithPriority Class.Log) -> TestTree-tests recorder = testGroup+tests :: TestTree+tests = testGroup "class"- [codeActionTests recorder , codeLensTests recorder]+ [codeActionTests, codeLensTests] -codeActionTests :: Recorder (WithPriority Class.Log) -> TestTree-codeActionTests recorder = testGroup+codeActionTests :: TestTree+codeActionTests = testGroup "code actions" [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do- runSessionWithServer (classPlugin recorder) testDataDir $ do+ runSessionWithServer classPlugin testDataDir $ do doc <- openDoc "T1.hs" "haskell" _ <- waitForDiagnosticsFromSource doc "typecheck" caResults <- getAllCodeActions doc@@ -51,40 +43,40 @@ , Just "Add placeholders for '/='" , Just "Add placeholders for '/=' with signature(s)" ]- , goldenWithClass recorder "Creates a placeholder for '=='" "T1" "eq" $ \(eqAction:_) -> do+ , goldenWithClass "Creates a placeholder for '=='" "T1" "eq" $ \(eqAction:_) -> do executeCodeAction eqAction- , goldenWithClass recorder "Creates a placeholder for '/='" "T1" "ne" $ \(_:_:neAction:_) -> do+ , goldenWithClass "Creates a placeholder for '/='" "T1" "ne" $ \(_:_:neAction:_) -> do executeCodeAction neAction- , goldenWithClass recorder "Creates a placeholder for 'fmap'" "T2" "fmap" $ \(_:_:_:_:fmapAction:_) -> do+ , goldenWithClass "Creates a placeholder for 'fmap'" "T2" "fmap" $ \(_:_:_:_:fmapAction:_) -> do executeCodeAction fmapAction- , goldenWithClass recorder "Creates a placeholder for multiple methods 1" "T3" "1" $ \(mmAction:_) -> do+ , goldenWithClass "Creates a placeholder for multiple methods 1" "T3" "1" $ \(mmAction:_) -> do executeCodeAction mmAction- , goldenWithClass recorder "Creates a placeholder for multiple methods 2" "T3" "2" $ \(_:_:mmAction:_) -> do+ , goldenWithClass "Creates a placeholder for multiple methods 2" "T3" "2" $ \(_:_:mmAction:_) -> do executeCodeAction mmAction- , goldenWithClass recorder "Creates a placeholder for a method starting with '_'" "T4" "" $ \(_fAction:_) -> do+ , goldenWithClass "Creates a placeholder for a method starting with '_'" "T4" "" $ \(_fAction:_) -> do executeCodeAction _fAction- , goldenWithClass recorder "Creates a placeholder for '==' with extra lines" "T5" "" $ \(eqAction:_) -> do+ , goldenWithClass "Creates a placeholder for '==' with extra lines" "T5" "" $ \(eqAction:_) -> do executeCodeAction eqAction- , goldenWithClass recorder "Creates a placeholder for only the unimplemented methods of multiple methods" "T6" "1" $ \(gAction:_) -> do+ , goldenWithClass "Creates a placeholder for only the unimplemented methods of multiple methods" "T6" "1" $ \(gAction:_) -> do executeCodeAction gAction- , goldenWithClass recorder "Creates a placeholder for other two methods" "T6" "2" $ \(_:_:ghAction:_) -> do+ , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $ \(_:_:ghAction:_) -> do executeCodeAction ghAction- , onlyRunForGhcVersions [GHC92] "Only ghc-9.2 enabled GHC2021 implicitly" $- goldenWithClass recorder "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ \(_:eqWithSig:_) -> do+ , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $+ goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ \(_:eqWithSig:_) -> do executeCodeAction eqWithSig- , goldenWithClass recorder "Insert pragma if not exist" "InsertWithoutPragma" "" $ \(_:eqWithSig:_) -> do+ , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ \(_:eqWithSig:_) -> do executeCodeAction eqWithSig- , goldenWithClass recorder "Don't insert pragma if exist" "InsertWithPragma" "" $ \(_:eqWithSig:_) -> do+ , goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $ \(_:eqWithSig:_) -> do executeCodeAction eqWithSig- , goldenWithClass recorder "Only insert pragma once" "InsertPragmaOnce" "" $ \(_:multi:_) -> do+ , goldenWithClass "Only insert pragma once" "InsertPragmaOnce" "" $ \(_:multi:_) -> do executeCodeAction multi ] -codeLensTests :: Recorder (WithPriority Class.Log) -> TestTree-codeLensTests recorder = testGroup+codeLensTests :: TestTree+codeLensTests = testGroup "code lens" [ testCase "Has code lens" $ do- runSessionWithServer (classPlugin recorder) testDataDir $ do+ runSessionWithServer classPlugin testDataDir $ do doc <- openDoc "CodeLensSimple.hs" "haskell" lens <- getCodeLenses doc let titles = map (^. J.title) $ mapMaybe (^. J.command) lens@@ -92,14 +84,14 @@ [ "(==) :: B -> B -> Bool" , "(==) :: A -> A -> Bool" ]- , goldenCodeLens recorder "Apply code lens" "CodeLensSimple" 1- , goldenCodeLens recorder "Apply code lens for local class" "LocalClassDefine" 0- , goldenCodeLens recorder "Apply code lens on the same line" "Inline" 0- , goldenCodeLens recorder "Don't insert pragma while existing" "CodeLensWithPragma" 0- , onlyRunForGhcVersions [GHC92] "Only ghc-9.2 enabled GHC2021 implicitly" $- goldenCodeLens recorder "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0- , goldenCodeLens recorder "Qualified name" "Qualified" 0- , goldenCodeLens recorder "Type family" "TypeFamily" 0+ , goldenCodeLens "Apply code lens" "CodeLensSimple" 1+ , goldenCodeLens "Apply code lens for local class" "LocalClassDefine" 0+ , goldenCodeLens "Apply code lens on the same line" "Inline" 0+ , goldenCodeLens "Don't insert pragma while existing" "CodeLensWithPragma" 0+ , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $+ goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0+ , goldenCodeLens "Qualified name" "Qualified" 0+ , goldenCodeLens "Type family" "TypeFamily" 0 ] _CACodeAction :: Prism' (Command |? CodeAction) CodeAction@@ -108,16 +100,16 @@ _ -> Nothing -goldenCodeLens :: Recorder (WithPriority Class.Log) -> TestName -> FilePath -> Int -> TestTree-goldenCodeLens recorder title path idx =- goldenWithHaskellDoc (classPlugin recorder) title testDataDir path "expected" "hs" $ \doc -> do+goldenCodeLens :: TestName -> FilePath -> Int -> TestTree+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) -goldenWithClass :: Recorder (WithPriority Class.Log) -> TestName -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree-goldenWithClass recorder title path desc act =- goldenWithHaskellDoc (classPlugin recorder) title testDataDir path (desc <.> "expected") "hs" $ \doc -> do+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" actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc act actions