hls-class-plugin 1.0.0.0 → 1.0.0.1
raw patch · 13 files changed
+239/−39 lines, 13 filesdep +bytestringdep +filepathdep +hls-class-plugindep ~basedep ~ghcidedep ~hls-plugin-apiPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring, filepath, hls-class-plugin, hls-test-utils, lsp-test, lsp-types
Dependency ranges changed: base, ghcide, hls-plugin-api
API changes (from Hackage documentation)
Files
- hls-class-plugin.cabal +49/−22
- src/Ide/Plugin/Class.hs +18/−17
- test/Main.hs +78/−0
- test/testdata/T1.eq.expected.hs +6/−0
- test/testdata/T1.hs +5/−0
- test/testdata/T1.ne.expected.hs +6/−0
- test/testdata/T2.fmap.expected.hs +13/−0
- test/testdata/T2.hs +12/−0
- test/testdata/T3.1.expected.hs +13/−0
- test/testdata/T3.2.expected.hs +13/−0
- test/testdata/T3.hs +11/−0
- test/testdata/T4.expected.hs +8/−0
- test/testdata/T4.hs +7/−0
hls-class-plugin.cabal view
@@ -1,10 +1,13 @@-cabal-version: 2.2+cabal-version: 2.4 name: hls-class-plugin-version: 1.0.0.0-synopsis: Class/instance management plugin for Haskell Language Server+version: 1.0.0.1+synopsis:+ Class/instance management plugin for Haskell Language Server+ description:- Class/instance management plugin for Haskell Language Server.- For usage, please see README of HLS on GitHub at <https://github.com/haskell/haskell-language-server#readme>+ Class/instance management plugin for Haskell Language Server.+ For usage, please see README of HLS on GitHub at <https://github.com/haskell/haskell-language-server#readme>+ license: Apache-2.0 license-file: LICENSE author: Junyoung Clare Jang@@ -13,24 +16,48 @@ bug-reports: https://github.com/haskell/haskell-language-server/issues category: Development build-type: Simple+extra-source-files:+ LICENSE+ test/testdata/*.hs library- exposed-modules: Ide.Plugin.Class- hs-source-dirs: src- build-depends: aeson- , base >=4.12 && <5- , containers- , lsp- , hls-plugin-api ^>= 1.0.0.0- , ghc- , ghc-exactprint- , ghcide ^>= 1.0.0.0- , lens- , shake- , text- , transformers- , unordered-containers+ exposed-modules: Ide.Plugin.Class+ hs-source-dirs: src+ build-depends:+ , aeson+ , base >=4.12 && <5+ , containers+ , ghc+ , ghc-exactprint+ , ghcide ^>=1.2+ , hls-plugin-api ^>=1.1+ , lens+ , lsp+ , shake+ , text+ , transformers+ , unordered-containers + default-language: Haskell2010+ default-extensions:+ DataKinds+ TypeOperators++ ghc-options: -Wno-unticked-promoted-constructors++test-suite tests+ type: exitcode-stdio-1.0 default-language: Haskell2010- default-extensions: DataKinds, TypeOperators- ghc-options: -Wno-unticked-promoted-constructors+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ , base+ , bytestring+ , filepath+ , hls-class-plugin+ , hls-test-utils ^>= 1.0+ , lens+ , lsp-test+ , lsp-types+ , text
src/Ide/Plugin/Class.hs view
@@ -12,30 +12,32 @@ import Class import ConLike import Control.Applicative-import Control.Lens hiding (List, use)+import Control.Lens hiding (List, use) import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Aeson import Data.Char import Data.List-import qualified Data.Map.Strict as Map+import qualified Data.Map.Strict as Map import Data.Maybe-import qualified Data.Text as T-import Development.IDE hiding (pluginHandlers)-import Development.IDE.Core.PositionMapping (fromCurrentRange, toCurrentRange)-import Development.IDE.GHC.Compat hiding (getLoc)+import qualified Data.Text as T+import Development.IDE hiding (pluginHandlers)+import Development.IDE.Core.PositionMapping (fromCurrentRange,+ toCurrentRange)+import Development.IDE.GHC.Compat hiding (getLoc) import Development.IDE.Spans.AtPoint-import qualified GHC.Generics as Generics-import GhcPlugins hiding (Var, getLoc, (<>))+import qualified GHC.Generics as Generics+import GhcPlugins hiding (Var, getLoc,+ (<>)) import Ide.PluginUtils import Ide.Types import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl)-import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, Parens)+import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, Parens) import Language.LSP.Server import Language.LSP.Types-import qualified Language.LSP.Types.Lens as J+import qualified Language.LSP.Types.Lens as J import SrcLoc import TcEnv import TcRnMonad@@ -87,7 +89,7 @@ makeMethodDecl df mName = case parseDecl df (T.unpack mName) . T.unpack $ toMethodName mName <> " = _" of Right (ann, d) -> Just (setPrecedingLines d 1 indent ann, d)- Left _ -> Nothing+ Left _ -> Nothing addMethodDecls :: ParsedSource -> [LHsDecl GhcPs] -> Transform (Located (HsModule GhcPs)) addMethodDecls ps mDecls = do@@ -161,10 +163,9 @@ mkCmdParams methodGroup = [toJSON (AddMinimalMethodsParams uri range (List methodGroup))] - mkCodeAction title+ mkCodeAction title cmd = InR- . CodeAction title (Just CodeActionQuickFix) (Just (List [])) Nothing Nothing Nothing- . Just+ $ CodeAction title (Just CodeActionQuickFix) (Just (List [])) Nothing Nothing Nothing (Just cmd) Nothing findClassIdentifier docPath range = do (hieAstResult, pmap) <- MaybeT . runAction "classplugin" state $ useWithStale GetHieAst docPath@@ -203,7 +204,7 @@ minDefToMethodGroups :: BooleanFormula Name -> [[T.Text]] minDefToMethodGroups = go where- go (Var mn) = [[T.pack . occNameString . occName $ mn]]- go (Or ms) = concatMap (go . unLoc) ms- go (And ms) = foldr (liftA2 (<>)) [[]] (fmap (go . unLoc) ms)+ go (Var mn) = [[T.pack . occNameString . occName $ mn]]+ go (Or ms) = concatMap (go . unLoc) ms+ go (And ms) = foldr (liftA2 (<>)) [[]] (fmap (go . unLoc) ms) go (Parens m) = go (unLoc m)
+ test/Main.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+module Main+ ( main+ )+where++import Control.Lens hiding ((<.>))+import qualified Data.ByteString.Lazy as BS+import qualified Data.Text.Encoding as T+import qualified Ide.Plugin.Class as Class+import qualified Language.LSP.Types.Lens as J+import System.FilePath+import Test.Hls++main :: IO ()+main = defaultTestRunner tests++plugin :: PluginDescriptor IdeState+plugin = Class.descriptor "class"++tests :: TestTree+tests = testGroup+ "class"+ [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do+ runSessionWithServer plugin classPath $ do+ doc <- openDoc "T1.hs" "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ caResults <- getAllCodeActions doc+ liftIO $ map (^? _CACodeAction . J.title) caResults+ @?=+ [ Just "Add placeholders for '=='"+ , Just "Add placeholders for '/='"+ ]+ , glodenTest "Creates a placeholder for '=='" "T1" "eq"+ $ \(eqAction:_) -> do+ executeCodeAction eqAction+ , glodenTest "Creates a placeholder for '/='" "T1" "ne"+ $ \(_:neAction:_) -> do+ executeCodeAction neAction+ , glodenTest "Creates a placeholder for 'fmap'" "T2" "fmap"+ $ \(_:_:fmapAction:_) -> do+ executeCodeAction fmapAction+ , glodenTest "Creates a placeholder for multiple methods 1" "T3" "1"+ $ \(mmAction:_) -> do+ executeCodeAction mmAction+ , glodenTest "Creates a placeholder for multiple methods 2" "T3" "2"+ $ \(_:mmAction:_) -> do+ executeCodeAction mmAction+ , glodenTest "Creates a placeholder for a method starting with '_'" "T4" ""+ $ \(_fAction:_) -> do+ executeCodeAction _fAction+ ]++_CACodeAction :: Prism' (Command |? CodeAction) CodeAction+_CACodeAction = prism' InR $ \case+ InR action -> Just action+ _ -> Nothing++classPath :: FilePath+classPath = "test" </> "testdata"++glodenTest :: String -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree+glodenTest name fp deco execute+ = goldenGitDiff name (classPath </> fpWithDeco <.> "expected" <.> "hs")+ $ runSessionWithServer plugin classPath+ $ do+ doc <- openDoc (fp <.> "hs") "haskell"+ _ <- waitForDiagnosticsFromSource doc "typecheck"+ actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc+ execute actions+ BS.fromStrict . T.encodeUtf8 <$> skipManyTill anyMessage (getDocumentEdit doc)+ where+ fpWithDeco+ | deco == "" = fp+ | otherwise = fp <.> deco
+ test/testdata/T1.eq.expected.hs view
@@ -0,0 +1,6 @@+module T1 where++data X = X++instance Eq X where+ (==) = _
+ test/testdata/T1.hs view
@@ -0,0 +1,5 @@+module T1 where++data X = X++instance Eq X where
+ test/testdata/T1.ne.expected.hs view
@@ -0,0 +1,6 @@+module T1 where++data X = X++instance Eq X where+ (/=) = _
+ test/testdata/T2.fmap.expected.hs view
@@ -0,0 +1,13 @@+module T2 where++data X a+ = A a+ | B++instance+ (Eq a) => Eq (X a)+ where++instance+ Functor X where+ fmap = _
+ test/testdata/T2.hs view
@@ -0,0 +1,12 @@+module T2 where++data X a+ = A a+ | B++instance+ (Eq a) => Eq (X a)+ where++instance+ Functor X
+ test/testdata/T3.1.expected.hs view
@@ -0,0 +1,13 @@+module T3 where++class Test a where+ f :: a+ f = h+ g :: a+ h :: a+ h = f+ {-# MINIMAL f, g | g, h #-}++instance Test [a] where+ f = _+ g = _
+ test/testdata/T3.2.expected.hs view
@@ -0,0 +1,13 @@+module T3 where++class Test a where+ f :: a+ f = h+ g :: a+ h :: a+ h = f+ {-# MINIMAL f, g | g, h #-}++instance Test [a] where+ g = _+ h = _
+ test/testdata/T3.hs view
@@ -0,0 +1,11 @@+module T3 where++class Test a where+ f :: a+ f = h+ g :: a+ h :: a+ h = f+ {-# MINIMAL f, g | g, h #-}++instance Test [a] where
+ test/testdata/T4.expected.hs view
@@ -0,0 +1,8 @@+module T4 where++class Test a where+ _f :: a+ {-# MINIMAL _f #-}++instance Test Int where+ _f = _
+ test/testdata/T4.hs view
@@ -0,0 +1,7 @@+module T4 where++class Test a where+ _f :: a+ {-# MINIMAL _f #-}++instance Test Int where