Skip to content

Commit

Permalink
Merge master
Browse files Browse the repository at this point in the history
  • Loading branch information
July541 committed Jun 20, 2022
2 parents 22fab55 + e398907 commit 375db1c
Show file tree
Hide file tree
Showing 11 changed files with 45 additions and 20 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -202,7 +202,7 @@ minDefToMethodGroups range sigs = go
where
go (Var mn) = [[ (T.pack . occNameString . occName $ mn, bindRendered sig)
| sig <- sigs
, inRange range (getSrcSpan (bindName sig))
, inRange range (getSrcSpan $ bindName sig)
, printOutputable mn == T.drop (T.length bindingPrefix) (printOutputable (bindName sig))
]]
go (Or ms) = concatMap (go . unLoc) ms
Expand Down
4 changes: 2 additions & 2 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -86,8 +86,8 @@ codeLens state plId CodeLensParams{..} = do
-- Existed signatures' name
sigNames = concat $ mapMaybe (\(L _ r) -> getSigName r) cid_sigs
toBindInfo (L l (L l' _)) = BindInfo
(getLoc l) -- bindSpan
(getLoc l') -- bindNameSpan
(locA l) -- bindSpan
(locA l') -- bindNameSpan
in toBindInfo <$> filter (\(L _ name) -> unLoc name `notElem` sigNames) bindNames
getBindSpanWithoutSig _ = []

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -118,5 +118,5 @@ addMethodDecls ps mDecls range withSig = do
foldM (insertAfter d) ps (reverse decls)

findInstDecl :: ParsedSource -> Range -> Transform (LHsDecl GhcPs)
findInstDecl ps range = head . filter (inRange range) <$> hsDecls ps
findInstDecl ps range = head . filter (inRange range . getLoc) <$> hsDecls ps
#endif
21 changes: 12 additions & 9 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -99,17 +99,20 @@ rules recorder = do
(_, maybe [] catMaybes -> instanceBinds) <-
initTcWithGbl hsc gblEnv ghostSpan $ traverse bindToSig binds
pure $ Just $ InstanceBindTypeSigsResult instanceBinds
where
rdrEnv = tcg_rdr_env gblEnv
showDoc ty = showSDocForUser' hsc (mkPrintUnqualifiedDefault hsc rdrEnv) (pprSigmaType ty)

bindToSig id = do
let name = idName id
whenMaybe (isBindingName name) $ do
env <- tcInitTidyEnv
let (_, ty) = tidyOpenType env (idType id)
pure $ InstanceBindTypeSig name
(prettyBindingNameString (printOutputable name) <> " :: " <> T.pack (showDoc ty))
Nothing
instanceBindType _ _ = pure Nothing

bindToSig id = do
let name = idName id
whenMaybe (isBindingName name) $ do
env <- tcInitTidyEnv
let (_, ty) = tidyOpenType env (idType id)
pure $ InstanceBindTypeSig name
(prettyBindingNameString (printOutputable name) <> " :: " <> printOutputable (pprSigmaType ty))
Nothing

properties :: Properties
'[ 'PropertyKey "typelensOn" 'TBoolean]
properties = emptyProperties
Expand Down
4 changes: 2 additions & 2 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,8 +25,8 @@ isBindingName :: Name -> Bool
isBindingName name = isPrefixOf bindingPrefix $ occNameString $ nameOccName name

-- | Check if some `HasSrcSpan` value in the given range
inRange :: HasSrcSpan a => Range -> a -> Bool
inRange range s = maybe False (subRange range) (srcSpanToRange (getLoc s))
inRange :: Range -> SrcSpan -> Bool
inRange range s = maybe False (subRange range) (srcSpanToRange s)

ghostSpan :: RealSrcSpan
ghostSpan = realSrcLocSpan $ mkRealSrcLoc (fsLit "<haskell-language-sever>") 1 1
Expand Down
3 changes: 2 additions & 1 deletion plugins/hls-class-plugin/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ codeActionTests recorder = testGroup
, goldenWithClass recorder "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" "T15" "" $ \(_:eqWithSig:_) -> do
goldenWithClass recorder "Don't insert pragma with GHC2021" "T16" "" $ \(_:eqWithSig:_) -> do
executeCodeAction eqWithSig
, goldenWithClass recorder "Insert pragma if not exist" "T7" "" $ \(_:eqWithSig:_) -> do
executeCodeAction eqWithSig
Expand Down Expand Up @@ -107,6 +107,7 @@ codeLensTests recorder = testGroup
, goldenCodeLens recorder "Don't insert pragma while existing" "T13" 0
, onlyRunForGhcVersions [GHC92] "Only ghc-9.2 enabled GHC2021 implicitly" $
goldenCodeLens recorder "Don't insert pragma while GHC2021 enabled" "T14" 0
, goldenCodeLens recorder "Qualified name" "T15" 0
]

_CACodeAction :: Prism' (Command |? CodeAction) CodeAction
Expand Down
10 changes: 10 additions & 0 deletions plugins/hls-class-plugin/test/testdata/T15.expected.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
{-# LANGUAGE InstanceSigs #-}
module T15 where
import qualified T15A

class F a where
f :: a

instance F T15A.A where
f :: T15A.A
f = undefined
9 changes: 6 additions & 3 deletions plugins/hls-class-plugin/test/testdata/T15.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
{-# LANGUAGE GHC2021#-}
module T15 where
import qualified T15A

data A
instance Eq A
class F a where
f :: a

instance F T15A.A where
f = undefined
3 changes: 3 additions & 0 deletions plugins/hls-class-plugin/test/testdata/T15A.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
module T15A where

data A
5 changes: 5 additions & 0 deletions plugins/hls-class-plugin/test/testdata/T16.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{-# LANGUAGE GHC2021#-}
module T16 where

data A
instance Eq A
2 changes: 1 addition & 1 deletion plugins/hls-class-plugin/test/testdata/hie.yaml
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
cradle:
direct:
arguments: [-XHaskell2010]
arguments: [-XHaskell2010, T15A]

0 comments on commit 375db1c

Please sign in to comment.