Add unused binding test

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,

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

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

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

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|]
+      )
+    ]