Skip to content

Commit

Permalink
Fix -Wall and -Wunused-packages in hls-class-plugin (haskell#3972)
Browse files Browse the repository at this point in the history
* Fix -Wunused-packages in class plugin

* -Wall and hlint fixes

* Fix type annotation for ghc 9.6+
  • Loading branch information
jhrcek authored Jan 17, 2024
1 parent 4361687 commit 78dacc5
Show file tree
Hide file tree
Showing 4 changed files with 29 additions and 20 deletions.
10 changes: 5 additions & 5 deletions plugins/hls-class-plugin/hls-class-plugin.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,11 @@ source-repository head
type: git
location: https://github.com/haskell/haskell-language-server.git

common warnings
ghc-options: -Wall -Wno-unticked-promoted-constructors -Wno-name-shadowing -Wunused-packages

library
import: warnings
-- Plugins that need exactprint have not been updated for 9.8 yet
if impl(ghc >= 9.8)
buildable: False
Expand All @@ -46,7 +50,6 @@ library
, ghc
, ghc-exactprint >= 1.5
, ghcide == 2.6.0.0
, ghc-boot-th
, hls-graph
, hls-plugin-api == 2.6.0.0
, lens
Expand All @@ -61,9 +64,8 @@ library
TypeOperators
OverloadedStrings

ghc-options: -Wall -Wno-unticked-promoted-constructors -Wno-name-shadowing

test-suite tests
import: warnings
if impl(ghc >= 9.8)
buildable: False
else
Expand All @@ -74,12 +76,10 @@ test-suite tests
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
, aeson
, base
, filepath
, ghcide
, hls-class-plugin
, hls-plugin-api
, hls-test-utils == 2.6.0.0
, lens
, lsp-types
Expand Down
4 changes: 2 additions & 2 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ import Language.LSP.Server

addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do
caps <- lift $ getClientCapabilities
caps <- lift getClientCapabilities
nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri)
pm <- runActionE "classplugin.addMethodPlaceholders.GetParsedModule" state
$ useE GetParsedModule nfp
Expand Down Expand Up @@ -239,6 +239,6 @@ minDefToMethodGroups hsc gblEnv range sigs minDef = makeMethodGroup <$> go minDe

go (Var mn) = pure $ makeMethodDefinitions hsc gblEnv range $ filter ((==) (printOutputable mn) . signatureToName) sigs
go (Or ms) = concatMap (go . unLoc) ms
go (And ms) = foldr (liftA2 (<>)) [[]] (fmap (go . unLoc) ms)
go (And ms) = foldr (liftA2 (<>) . go . unLoc) [[]] ms
go (Parens m) = go (unLoc m)

34 changes: 22 additions & 12 deletions plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,10 +13,11 @@ import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Parsers

import Data.Either.Extra (eitherToMaybe)
import Data.Functor.Identity (Identity)
import GHC.Parser.Annotation
import Language.LSP.Protocol.Types (Range)

makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text)
-- addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located HsModule)
makeEditText pm df AddMinimalMethodsParams{..} = do
mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup
let ps = makeDeltaAst $ pm_parsed_source pm
Expand All @@ -31,14 +32,21 @@ makeMethodDecl df (mName, sig) = do
sig' <- eitherToMaybe $ parseDecl df (T.unpack sig) $ T.unpack sig
pure (name, sig')

#if MIN_VERSION_ghc(9,5,0)
addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located (HsModule GhcPs))
#else
addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located HsModule)
#endif
addMethodDecls ps mDecls range withSig
| withSig = go (concatMap (\(decl, sig) -> [sig, decl]) mDecls)
| otherwise = go (map fst mDecls)
where
go inserting = do
allDecls <- hsDecls ps
let (before, ((L l inst): after)) = break (inRange range . getLoc) allDecls
replaceDecls ps (before ++ (L l (addWhere inst)): (map newLine inserting ++ after))
case break (inRange range . getLoc) allDecls of
(before, L l inst : after) -> replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after))
(before, []) -> replaceDecls ps before

-- Add `where` keyword for `instance X where` if `where` is missing.
--
-- The `where` in ghc-9.2 is now stored in the instance declaration
Expand All @@ -48,15 +56,17 @@ addMethodDecls ps mDecls range withSig
--
-- See the link for the original definition:
-- https://hackage.haskell.org/package/ghc-9.2.1/docs/Language-Haskell-Syntax-Extension.html#t:XCClsInstDecl
addWhere (InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) =
let (EpAnn entry anns comments, key) = cid_ext
in InstD xInstD (ClsInstD ext decl {
cid_ext = (EpAnn
entry
(AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns)
comments
, key)
})
addWhere instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) =
case cid_ext of
(EpAnn entry anns comments, key) ->
InstD xInstD (ClsInstD ext decl {
cid_ext = (EpAnn
entry
(AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns)
comments
, key)
})
_ -> instd
addWhere decl = decl

newLine (L l e) =
Expand Down
1 change: 0 additions & 1 deletion plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -190,7 +190,6 @@ getInstanceBindLensRule recorder = do
(locA l) -- bindSpan
(locA l') -- bindNameSpan
in toBindInfo <$> filter (\(L _ name) -> unLoc name `notElem` sigNames) bindNames
getBindSpanWithoutSig _ = []

-- Get bind definition range with its rendered signature text
getRangeWithSig :: Maybe (InstanceBindTypeSig, SrcSpan) -> IO (Maybe (Range, Int, Name, Type))
Expand Down

0 comments on commit 78dacc5

Please sign in to comment.