From 11208f52843d6fa92a1b3771d75492fa1dabfb4d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 12 Jul 2024 11:20:31 -0700 Subject: [PATCH] Add unused binding test --- parser-typechecker/tests/Unison/Test/Term.hs | 2 +- unison-cli/src/Unison/LSP/Diagnostics.hs | 7 +- unison-cli/src/Unison/LSP/FileAnalysis.hs | 8 +- .../Unison/LSP/FileAnalysis/UnusedBindings.hs | 7 +- unison-cli/tests/Unison/Test/LSP.hs | 100 +++++++++++++++--- 5 files changed, 100 insertions(+), 24 deletions(-) diff --git a/parser-typechecker/tests/Unison/Test/Term.hs b/parser-typechecker/tests/Unison/Test/Term.hs index 31122f5aa..4791382bd 100644 --- a/parser-typechecker/tests/Unison/Test/Term.hs +++ b/parser-typechecker/tests/Unison/Test/Term.hs @@ -57,7 +57,7 @@ test = ref = R.Id h 0 v1 = Var.unnamedRef @Symbol ref -- input component: `ref = \v1 -> ref` - component = Map.singleton ref (Term.lam () v1 (Term.refId () ref)) + component = Map.singleton ref (Term.lam () ((), v1) (Term.refId () ref)) component' = Term.unhashComponent component -- expected unhashed component: `v2 = \v1 -> v2`, where `v2 /= v1`, -- i.e. `v2` cannot be just `ref` converted to a ref-named variable, diff --git a/unison-cli/src/Unison/LSP/Diagnostics.hs b/unison-cli/src/Unison/LSP/Diagnostics.hs index bf9d15498..9416fec9b 100644 --- a/unison-cli/src/Unison/LSP/Diagnostics.hs +++ b/unison-cli/src/Unison/LSP/Diagnostics.hs @@ -9,6 +9,7 @@ import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types import Unison.LSP.Types import Unison.Prelude +import Unison.Util.Monoid qualified as Monoid reportDiagnostics :: (Foldable f) => @@ -23,15 +24,15 @@ reportDiagnostics docUri fileVersion diags = do let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = toList $ diags} sendNotification (Msg.TNotificationMessage jsonRPC Msg.SMethod_TextDocumentPublishDiagnostics params) -mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> Text -> [(Text, Range)] -> Diagnostic -mkDiagnostic uri r severity msg references = +mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> [DiagnosticTag] -> Text -> [(Text, Range)] -> Diagnostic +mkDiagnostic uri r severity tags msg references = Diagnostic { _range = r, _severity = Just severity, _code = Nothing, -- We could eventually pass error codes here _source = Just "unison", _message = msg, - _tags = Nothing, + _tags = Monoid.whenM (not $ null tags) (Just tags), _relatedInformation = case references of [] -> Nothing diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index 76a6e8531..221e8957f 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -29,7 +29,6 @@ import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase import Unison.DataDeclaration qualified as DD import Unison.Debug qualified as Debug -import Debug.Trace import Unison.FileParsers (ShouldUseTndr (..)) import Unison.FileParsers qualified as FileParsers import Unison.KindInference.Error qualified as KindInference @@ -112,8 +111,6 @@ checkFile doc = runMaybeT do & foldMap (\(RangedCodeAction {_codeActionRanges, _codeAction}) -> (,_codeAction) <$> _codeActionRanges) & toRangeMap let typeSignatureHints = fromMaybe mempty (mkTypeSignatureHints <$> parsedFile <*> typecheckedFile) - for_ (parsedFile & foldMap (Map.toList . UF.terms )) \(v, (_, trm)) -> do - traceM (show $ (v, trm)) let fileSummary = FileSummary.mkFileSummary parsedFile typecheckedFile let unusedBindingDiagnostics = fileSummary ^.. _Just . to termsBySymbol . folded . folding (\(_topLevelAnn, _refId, trm, _type) -> UnusedBindings.analyseTerm fileUri trm) let tokenMap = getTokenMap tokens @@ -197,6 +194,7 @@ computeConflictWarningDiagnostics fileUri fileSummary@FileSummary {fileNames} = fileUri newRange DiagnosticSeverity_Information + [] msg mempty pure $ toDiagnostics conflictedTermLocations <> toDiagnostics conflictedTypeLocations @@ -283,7 +281,7 @@ analyseNotes fileUri ppe src notes = do (errMsg, ranges) <- PrintError.renderParseErrors src err let txtMsg = Text.pack $ Pretty.toPlain 80 errMsg range <- ranges - pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error txtMsg [] + pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error [] txtMsg [] -- TODO: Some parsing errors likely have reasonable code actions pure (diags, []) Result.UnknownSymbol _ loc -> @@ -339,7 +337,7 @@ analyseNotes fileUri ppe src notes = do let msg = Text.pack $ Pretty.toPlain 80 $ PrintError.printNoteWithSource ppe src note in do (range, references) <- ranges - pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error msg references + pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error [] msg references -- Suggest name replacements or qualifications when there's ambiguity nameResolutionCodeActions :: [Diagnostic] -> [Context.Suggestion Symbol Ann] -> [RangedCodeAction] nameResolutionCodeActions diags suggestions = do diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 05074f78d..46d87c6ec 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -14,6 +14,7 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol (..)) import Unison.Term (Term) +import Unison.Util.Range qualified as Range import Unison.Var qualified as Var analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] @@ -24,8 +25,10 @@ analyseTerm fileUri tm = (,ann) <$> getRelevantVarName v diagnostics = vars & mapMaybe \(varName, ann) -> do - lspRange <- Cv.annToRange ann - pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning ("Unused binding " <> varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] + -- Limit the range to the first line of the binding to not be too annoying. + -- Maybe in the future we can get the actual annotation of the variable name. + lspRange <- Cv.uToLspRange . Range.startingLine <$> Cv.annToURange ann + pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning [Lsp.DiagnosticTag_Unnecessary] ("Unused binding " <> tShow varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") [] in diagnostics where getRelevantVarName :: Symbol -> Maybe Text diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 5b4246790..880fd6214 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -10,6 +10,8 @@ import Data.String.Here.Uninterpolated (here) import Data.Text import Data.Text qualified as Text import EasyTest +import Language.LSP.Protocol.Lens qualified as LSP +import Language.LSP.Protocol.Types qualified as LSP import System.IO.Temp qualified as Temp import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef) @@ -20,6 +22,8 @@ import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.SqliteCodebase qualified as SC import Unison.ConstructorReference (GConstructorReference (..)) import Unison.FileParsers qualified as FileParsers +import Unison.LSP.Conversions qualified as Cv +import Unison.LSP.FileAnalysis.UnusedBindings qualified as UnusedBindings import Unison.LSP.Queries qualified as LSPQ import Unison.Lexer.Pos qualified as Lexer import Unison.Parser.Ann (Ann (..)) @@ -43,6 +47,10 @@ test = do [ refFinding, annotationNesting ] + scope "diagnostics" $ + tests + [ unusedBindingLocations + ] trm :: Term.F Symbol () () (ABT.Term (Term.F Symbol () ()) Symbol ()) -> LSPQ.SourceNode () trm = LSPQ.TermNode . ABT.tm @@ -239,15 +247,39 @@ term = let ) ] --- | Test helper which lets you specify a cursor position inline with source text as a '|'. +-- | Test helper which lets you specify a cursor position inline with source text as a '^'. extractCursor :: Text -> Test (Lexer.Pos, Text) extractCursor txt = - case Text.splitOn "^" txt of + case splitOnDelimiter '^' txt of + Nothing -> crash "expected exactly one cursor" + Just (before, pos, after) -> pure (pos, before <> after) + +-- | Splits a text on a delimiter, returning the text before and after the delimiter, along with the position of the delimiter. +-- +-- >>> splitOnDelimiter '^' "foo b^ar baz" +-- Just ("foo b",Pos {line = 0, column = 5},"ar baz") +splitOnDelimiter :: Char -> Text -> Maybe (Text, Lexer.Pos, Text) +splitOnDelimiter sym txt = + case Text.splitOn (Text.singleton sym) txt of [before, after] -> - let col = Text.length $ Text.takeWhileEnd (/= '\n') before - line = Prelude.length $ Text.lines before - in pure $ (Lexer.Pos line col, before <> after) - _ -> crash "expected exactly one cursor" + let col = (Text.length $ Text.takeWhileEnd (/= '\n') before) + 1 + line = Text.count "\n" before + 1 + in Just $ (before, Lexer.Pos line col, after) + _ -> Nothing + +-- | Test helper which lets you specify a cursor position inline with source text as a '^'. +-- +-- >>> extractDelimitedBlock ('{', '}') "foo {bar} baz" +-- Just (Ann {start = Pos {line = 1, column = 4}, end = Pos {line = 1, column = 7}},"bar","foo bar baz") +-- +-- >>> extractDelimitedBlock ('{', '}') "term =\n {foo} = 12345" +-- Just (Ann {start = Pos {line = 2, column = 2}, end = Pos {line = 2, column = 5}},"foo","term =\n foo = 12345") +extractDelimitedBlock :: (Char, Char) -> Text -> Maybe (Ann {- ann spanning the inside of the delimiters -}, Text {- Text within the delimiters -}, Text {- entire source text with the delimiters stripped -}) +extractDelimitedBlock (startDelim, endDelim) txt = do + (beforeStart, startPos, afterStart) <- splitOnDelimiter startDelim txt + (beforeEnd, endPos, afterEnd) <- splitOnDelimiter endDelim (beforeStart <> afterStart) + let ann = Ann startPos endPos + pure (ann, Text.takeWhile (/= endDelim) afterStart, beforeEnd <> afterEnd) makeNodeSelectionTest :: (String, Text, Bool, LSPQ.SourceNode ()) -> Test () makeNodeSelectionTest (name, testSrc, testTypechecked, expected) = scope name $ do @@ -308,7 +340,7 @@ annotationNestingTest (name, src) = scope name do & traverse_ \(_fileAnn, _refId, _wk, trm, _typ) -> assertAnnotationsAreNested trm --- | Asserts that for all nodes in the provided ABT, the annotations of all child nodes are +-- | Asserts that for all nodes in the provided ABT EXCEPT Abs nodes, the annotations of all child nodes are -- within the span of the parent node. assertAnnotationsAreNested :: forall f. (Foldable f, Functor f, Show (f (Either String Ann))) => ABT.Term f Symbol Ann -> Test () assertAnnotationsAreNested term = do @@ -319,12 +351,19 @@ assertAnnotationsAreNested term = do alg :: Ann -> ABT.ABT f Symbol (Either String Ann) -> Either String Ann alg ann abt = do childSpan <- abt & foldMapM id - case ann `Ann.encompasses` childSpan of - -- one of the annotations isn't in the file, don't bother checking. - Nothing -> pure (ann <> childSpan) - Just isInFile - | isInFile -> pure ann - | otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt) + case abt of + -- Abs nodes are the only nodes whose annotations are allowed to not contain their children, + -- they represet the location of the variable being bound instead. Ideally we'd have a separate child + -- node for that, but we can't add it without editing the ABT or Term types. + ABT.Abs _ _ -> + pure (ann <> childSpan) + _ -> do + case ann `Ann.encompasses` childSpan of + -- one of the annotations isn't in the file, don't bother checking. + Nothing -> pure (ann <> childSpan) + Just isInFile + | isInFile -> pure ann + | otherwise -> Left $ "Containment breach: children aren't contained with the parent:" <> show (ann, abt) typecheckSrc :: String -> @@ -374,3 +413,38 @@ withTestCodebase action = do tmpDir <- Temp.createTempDirectory tmp "lsp-test" Codebase.Init.withCreatedCodebase SC.init "lsp-test" tmpDir SC.DontLock action either (crash . show) pure r + +makeDiagnosticRangeTest :: (String, Text) -> Test () +makeDiagnosticRangeTest (testName, testSrc) = scope testName $ do + (ann, _block, cleanSrc) <- case extractDelimitedBlock ('«', '»') testSrc of + Nothing -> crash "expected exactly one delimited block" + Just r -> pure r + (pf, _mayTypecheckedFile) <- typecheckSrc testName cleanSrc + UF.terms pf + & Map.elems + & \case + [(_a, trm)] -> do + case UnusedBindings.analyseTerm (LSP.Uri "test") trm of + [diag] -> do + let expectedRange = Cv.annToRange ann + let actualRange = Just (diag ^. LSP.range) + when (expectedRange /= actualRange) do + crash $ "Expected diagnostic at range: " <> show expectedRange <> ", got: " <> show actualRange + _ -> crash "Expected exactly one diagnostic" + _ -> crash "Expected exactly one term" + +unusedBindingLocations :: Test () +unusedBindingLocations = + scope "unused bindings" . tests . fmap makeDiagnosticRangeTest $ + [ ( "Unused binding in let block", + [here|term = + usedOne = true + «unused = "unused"» + usedTwo = false + usedOne && usedTwo + |] + ), + ( "Unused argument", + [here|term «unused» = 1|] + ) + ]