Skip to content
This repository was archived by the owner on Jan 2, 2021. It is now read-only.

Enhancements to top-level signatures #232

Merged
merged 8 commits into from
Dec 16, 2019
Merged

Enhancements to top-level signatures #232

Show file tree
Hide file tree
Changes from 7 commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
b221936
Try adding a dependency on TypeCheck
serras Dec 11, 2019
a2771d9
Show warning regardless of the status of -Wall
serras Dec 11, 2019
f042cff
Try diagnostics after type checking, again
serras Dec 11, 2019
4541807
Use `useE` instead of `use_` to not get a `BadDependency` error
serras Dec 12, 2019
3a3a020
Degrade information about signatures if not present in user options
serras Dec 12, 2019
4614474
Fix tests
serras Dec 12, 2019
83733c8
Better suggested signatures for polymorphic bindings
serras Dec 12, 2019
122128e
Remove old comment
serras Dec 16, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 30 additions & 7 deletions src/Development/IDE/Core/Compile.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -102,11 +102,20 @@ typecheckModule (IdeDefer defer) packageState deps pm =
catchSrcErrors "typecheck" $ do
setupEnv deps
let modSummary = pm_mod_summary pm
dflags = ms_hspp_opts modSummary
modSummary' <- initPlugins modSummary
(warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
GHC.typecheckModule $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
GHC.typecheckModule $ enableTopLevelWarnings
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I’ve brought this up a couple of times before but I really dislike the idea of enabling warnings by default. If users care about these warnings, they should enable them in their cabal file. I don’t want to see a bunch of warnings in my IDE that I haven’t enabled. If we manage to make this work such that we only show the codelenses by default but not the warnings, I could be convinced that this is fine but given that the codelenses are based on diagnostics this doesn’t seem trivial and I think the complexity of trying to make this work is probably not worth it.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am happy both ways. I can attempt to write something which remembers whether these warning were already in effect at the beginning, so that we can filter out diagnostics if needed. But I agree: it might be quite complicated.
@ndmitchell you seemed to have an idea of how to achieve this in #231. Any suggestions?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Code which doesn't have a warning is more likely to have top-level signatures omitted, and more likely to benefit from having them as code lenses, since I see them as helpful docs, rather than a mechanism to easily add them. I separately think that turning on some warnings in the IDE vs compiler is reasonable, but see that as unrelated to this patch.

I'm not convinced the code is that complex. You turn on the warning always, but demote the warning to an info if errMsgReason is missing top level signatures. At some point (if we want) we ditch info level diagnostics before sending them to the LSP client. A few lines here, a few lines (that will be generally useful) in the diagnostic sending code.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am admittedly a bit biased here, I don’t recall the last time I worked on a project that didn’t have these warnings enabled and that seems to be quite common in the ecosystem in general, so I’m somewhat hesitant to add any complexity (even if it’s probably not too much) to cater to that usecase.

That said, the argument that we’ll need this for other warnings eventually that are less popular is compelling so I’m fine with adding it.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

None of my projects have it turned on :)

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That’s your loss :trollface:

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

My loss is not getting to work with you awesome guys every day anymore!

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

🤗

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It took a while, but finally I managed to "degrade" warnings about missing signatures to info level if they were not explicitly enabled by the user. They look great in VSCode, since they are shown with a blue underline.

$ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
tcm2 <- mkTcModuleResult tcm
return (map unDefer warnings, tcm2)
let errorPipeline = unDefer
. (if wopt Opt_WarnMissingSignatures dflags
then id
else degradeError Opt_WarnMissingSignatures)
. (if wopt Opt_WarnMissingLocalSignatures dflags
then id
else degradeError Opt_WarnMissingLocalSignatures)
return (map errorPipeline warnings, tcm2)

initPlugins :: GhcMonad m => ModSummary -> m ModSummary
initPlugins modSummary = do
Expand Down Expand Up @@ -170,25 +179,39 @@ demoteTypeErrorsToWarnings =
. (`gopt_set` Opt_DeferTypedHoles)
. (`gopt_set` Opt_DeferOutOfScopeVariables)

update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary
update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms}
enableTopLevelWarnings :: ParsedModule -> ParsedModule
enableTopLevelWarnings =
(update_pm_mod_summary . update_hspp_opts)
((`wopt_set` Opt_WarnMissingSignatures) . (`wopt_set` Opt_WarnMissingLocalSignatures))

update_pm_mod_summary :: (ModSummary -> ModSummary) -> ParsedModule -> ParsedModule
update_pm_mod_summary up pm =
pm{pm_mod_summary = up $ pm_mod_summary pm}
update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary
update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms}

update_pm_mod_summary :: (ModSummary -> ModSummary) -> ParsedModule -> ParsedModule
update_pm_mod_summary up pm =
pm{pm_mod_summary = up $ pm_mod_summary pm}

unDefer :: (WarnReason, FileDiagnostic) -> FileDiagnostic
unDefer (Reason Opt_WarnDeferredTypeErrors , fd) = upgradeWarningToError fd
unDefer (Reason Opt_WarnTypedHoles , fd) = upgradeWarningToError fd
unDefer (Reason Opt_WarnDeferredOutOfScopeVariables, fd) = upgradeWarningToError fd
unDefer ( _ , fd) = fd

degradeError :: WarningFlag -> (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic)
degradeError f (Reason f', fd)
| f == f' = (Reason f', degradeWarningToError fd)
degradeError _ wfd = wfd

upgradeWarningToError :: FileDiagnostic -> FileDiagnostic
upgradeWarningToError (nfp, fd) =
(nfp, fd{_severity = Just DsError, _message = warn2err $ _message fd}) where
warn2err :: T.Text -> T.Text
warn2err = T.intercalate ": error:" . T.splitOn ": warning:"

degradeWarningToError :: FileDiagnostic -> FileDiagnostic
degradeWarningToError (nfp, fd) =
(nfp, fd{_severity = Just DsInfo})

addRelativeImport :: NormalizedFilePath -> ParsedModule -> DynFlags -> DynFlags
addRelativeImport fp modu dflags = dflags
{importPaths = nubOrd $ maybeToList (moduleImportPath fp modu) ++ importPaths dflags}
Expand Down
32 changes: 26 additions & 6 deletions src/Development/IDE/LSP/CodeAction.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ module Development.IDE.LSP.CodeAction
import Language.Haskell.LSP.Types
import Development.IDE.GHC.Compat
import Development.IDE.Core.Rules
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.LSP.Server
import Development.IDE.Types.Location
Expand All @@ -24,6 +25,7 @@ import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Messages
import qualified Data.Rope.UTF16 as Rope
import Data.Aeson.Types (toJSON, fromJSON, Value(..), Result(..))
import Control.Monad.Trans.Maybe
import Data.Char
import Data.Maybe
import Data.List.Extra
Expand Down Expand Up @@ -53,14 +55,16 @@ codeLens
-> CodeLensParams
-> IO (List CodeLens)
codeLens _lsp ideState CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
diag <- getDiagnostics ideState
-- diag <- getDiagnostics ideState
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It looks like this line can be removed?

case uriToFilePath' uri of
Just (toNormalizedFilePath -> filePath) -> do
_ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath
diag <- getDiagnostics ideState
pure $ List
[ CodeLens _range (Just (Command title "typesignature.add" (Just $ List [toJSON edit]))) Nothing
| (dFile, dDiag@Diagnostic{_range=_range@Range{..},..}) <- diag
, dFile == filePath
, (title, tedit) <- suggestTopLevelBinding False dDiag
, (title, tedit) <- suggestSignature False dDiag
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
]
Nothing -> pure $ List []
Expand Down Expand Up @@ -177,12 +181,12 @@ suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}
extractFitNames = map (T.strip . head . T.splitOn " :: ")
in map proposeHoleFit $ nubOrd $ findSuggestedHoleFits _message

| tlb@[_] <- suggestTopLevelBinding True diag = tlb
| tlb@[_] <- suggestSignature True diag = tlb

suggestAction _ _ = []

suggestTopLevelBinding :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]
suggestTopLevelBinding isQuickFix Diagnostic{_range=_range@Range{..},..}
suggestSignature :: Bool -> Diagnostic -> [(T.Text, [TextEdit])]
suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
| "Top-level binding with no type signature" `T.isInfixOf` _message = let
filterNewlines = T.concat . T.lines
unifySpaces = T.unwords . T.words
Expand All @@ -192,7 +196,23 @@ suggestTopLevelBinding isQuickFix Diagnostic{_range=_range@Range{..},..}
title = if isQuickFix then "add signature: " <> signature else signature
action = TextEdit beforeLine $ signature <> "\n"
in [(title, [action])]
suggestTopLevelBinding _ _ = []
suggestSignature isQuickFix Diagnostic{_range=_range@Range{..},..}
| "Polymorphic local binding with no type signature" `T.isInfixOf` _message = let
filterNewlines = T.concat . T.lines
unifySpaces = T.unwords . T.words
signature = removeInitialForAll
$ T.takeWhile (\x -> x/='*' && x/='•')
$ T.strip $ unifySpaces $ last $ T.splitOn "type signature: " $ filterNewlines _message
startOfLine = Position (_line _start) (_character _start)
beforeLine = Range startOfLine startOfLine
title = if isQuickFix then "add signature: " <> signature else signature
action = TextEdit beforeLine $ signature <> "\n" <> T.replicate (_character _start) " "
in [(title, [action])]
where removeInitialForAll :: T.Text -> T.Text
removeInitialForAll (T.breakOnEnd " :: " -> (nm, ty))
| "forall" `T.isPrefixOf` ty = nm <> T.drop 2 (snd (T.breakOn "." ty))
| otherwise = nm <> ty
suggestSignature _ _ = []

topOfHoleFitsMarker :: T.Text
topOfHoleFitsMarker =
Expand Down
5 changes: 5 additions & 0 deletions test/exe/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -299,6 +299,7 @@ diagnosticTests = testGroup "diagnostics"
, testSessionWait "package imports" $ do
let thisDataListContent = T.unlines
[ "module Data.List where"
, "x :: Integer"
, "x = 123"
]
let mainContent = T.unlines
Expand Down Expand Up @@ -541,6 +542,7 @@ removeImportTests = testGroup "remove import actions"
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "import ModuleA"
, "stuffB :: Integer"
, "stuffB = 123"
]
docB <- openDoc' "ModuleB.hs" "haskell" contentB
Expand All @@ -553,6 +555,7 @@ removeImportTests = testGroup "remove import actions"
let expectedContentAfterAction = T.unlines
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "stuffB :: Integer"
, "stuffB = 123"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
Expand All @@ -565,6 +568,7 @@ removeImportTests = testGroup "remove import actions"
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "import qualified ModuleA"
, "stuffB :: Integer"
, "stuffB = 123"
]
docB <- openDoc' "ModuleB.hs" "haskell" contentB
Expand All @@ -577,6 +581,7 @@ removeImportTests = testGroup "remove import actions"
let expectedContentAfterAction = T.unlines
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "stuffB :: Integer"
, "stuffB = 123"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
Expand Down