demo

Author: DedSec256

ReSharper.FSharp/src/FSharp.Psi.Daemon/src/Stages/FcsErrorsStageProcessBase.fs

@@ -90,20 +90,6 @@ module FSharpErrors =
     let [<Literal>] XmlDocSignatureCheckFailed = 3390
     let [<Literal>] InvalidXmlDocPosition = 3520
 
-    let [<Literal>] ifExprMissingElseBranch = "This 'if' expression is missing an 'else' branch."
-    let [<Literal>] expressionIsAFunctionMessage = "This expression is a function value, i.e. is missing arguments. Its type is "
-    let [<Literal>] butItsSignatureSpecifies = "but its signature specifies"
-    let [<Literal>] theModuleContainsTheField = "The module contains the field"
-    let [<Literal>] typeConstraintMismatchMessage = "Type constraint mismatch. The type \n    '(.+)'    \nis not compatible with type\n    '(.+)'"
-
-    let [<Literal>] typeEquationMessage = "This expression was expected to have type\n    '(.+)'    \nbut here has type\n    '(.+)'"
-    let [<Literal>] typeDoesNotMatchMessage = "Type mismatch. Expecting a\n    '(.+)'    \nbut given a\n    '(.+)'"
-    let [<Literal>] elseBranchHasWrongTypeMessage = "All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is '(.+)'. This branch returns a value of type '(.+)'."
-    let [<Literal>] matchClauseHasWrongTypeMessage = "All branches of a pattern match expression must return values implicitly convertible to the type of the first branch, which here is '(.+)'. This branch returns a value of type '(.+)'."
-    let [<Literal>] ifBranchSatisfyContextTypeRequirements = "The 'if' expression needs to have type '(.+)' to satisfy context type requirements\. It currently has type '(.+)'"
-    let [<Literal>] typeMisMatchTupleLengths = "Type mismatch. Expecting a\n    '(.+)'    \nbut given a\n    '(.+)'    \nThe tuples have differing lengths of \\d+ and \\d+"
-    let [<Literal>] argumentNamesInTheSignatureAndImplementationDoNotMatch = "The argument names in the signature '(.+)' and implementation '(.+)' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling."
-
     let isDirectiveSyntaxError number =
         number >= 232 && number <= 235
 
@@ -194,33 +180,39 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
                 | null -> null
                 | expr -> highlightingCtor (expected, actual, expr, error.Message) :> _
 
-            match error.Message with
-            | message when message.StartsWith(ifExprMissingElseBranch, StringComparison.Ordinal) ->
+            match error.ExtendedData with
+            | Some(:? TypeMismatchDiagnosticExtendedData as data)
+                when data.ContextInfo = DiagnosticContextInfo.OmittedElseBranch ->
+
                 createHighlightingFromNodeWithMessage UnitTypeExpectedError range error
 
-            | Regex typeEquationMessage [expectedType; actualType]
-            | Regex elseBranchHasWrongTypeMessage [expectedType; actualType] ->
+            | Some(:? TypeMismatchDiagnosticExtendedData as data)
+                when data.ContextInfo = DiagnosticContextInfo.FollowingPatternMatchClause ->
+
+                createTypeMismatchHighlighting
+                    MatchClauseWrongTypeError
+                    (data.ExpectedType.Format(data.DisplayContext))
+                    (data.ActualType.Format(data.DisplayContext))
+            
+            | Some(:? TypeMismatchDiagnosticExtendedData as data) ->
+                let expectedType = data.ExpectedType
+                let actualType = data.ActualType
+                let dataDisplayContext = data.DisplayContext
+
+                if expectedType.IsTupleType && actualType.IsTupleType &&
+                   expectedType.GenericArguments.Count <> actualType.GenericArguments.Count then
+                   createTypeMismatchHighlighting TypeMisMatchTuplesHaveDifferingLengthsError (expectedType.Format(dataDisplayContext)) (actualType.Format(dataDisplayContext))
+
+                else
                 let expr = nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null)
                 let expr = getResultExpr expr
                 if isNotNull expr then
-                    match expectedType with
-                    | "unit" -> createHighlightingFromNodeWithMessage UnitTypeExpectedError range error
-                    | _ -> TypeEquationError(expectedType, actualType, expr, error.Message) :> _
+                    if data.ExpectedType.Format(dataDisplayContext) = "unit" then
+                        createHighlightingFromNodeWithMessage UnitTypeExpectedError range error
+                    else TypeEquationError(expectedType.Format(dataDisplayContext), actualType.Format(dataDisplayContext), expr, error.Message) :> _
                 else
                     null
 
-            | Regex matchClauseHasWrongTypeMessage [expectedType; actualType] ->
-                createTypeMismatchHighlighting MatchClauseWrongTypeError expectedType actualType
-            
-            | Regex typeMisMatchTupleLengths [expectedType; actualType] ->
-                createTypeMismatchHighlighting TypeMisMatchTuplesHaveDifferingLengthsError expectedType actualType
-
-            | Regex typeDoesNotMatchMessage [expectedType; actualType] ->
-                createTypeMismatchHighlighting TypeDoesNotMatchTypeError expectedType actualType
-
-            | Regex ifBranchSatisfyContextTypeRequirements [expectedType; actualType] ->
-                createTypeMismatchHighlighting IfExpressionNeedsTypeToSatisfyTypeRequirementsError expectedType actualType
-
             | _ -> createGenericHighlighting error range
 
         | NotAFunction ->
@@ -317,10 +309,10 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
             ValueNotMutableError(refExpr) :> _
 
         | ValueNotContainedMutability ->
-            if error.Message.EndsWith("The mutability attributes differ") then
+            match error.ExtendedData with
+            | Some (:? ValueNotContainedDiagnosticExtendedData) ->
                 createHighlightingFromNodeWithMessage ValueNotContainedMutabilityAttributesDifferError range error
-            else
-                createGenericHighlighting error range
+            | _ -> createGenericHighlighting error range
 
         | UnitTypeExpected ->
             createHighlightingFromMappedExpression getResultExpr UnitTypeExpectedWarning range error
@@ -422,11 +414,11 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
             createHighlightingFromNode LiteralPatternDoesNotTakeArgumentsError range
 
         | ArgumentNamesInSignatureAndImplementationDoNotMatch ->
-            match error.Message with
-            | Regex argumentNamesInTheSignatureAndImplementationDoNotMatch [ signature; implementation ] ->
+            match error.ExtendedData with
+            | Some (:? ArgumentsInSigAndImplMismatchExtendedData as data) ->
                 match nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null) with
                 | null -> null
-                | expr -> ArgumentNameMismatchWarning(expr, signature, implementation, error.Message) :> _
+                | expr -> ArgumentNameMismatchWarning(expr, data.SignatureName, data.ImplementationName, error.Message) :> _
 
             | _ -> null
 
@@ -472,23 +464,23 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
             createHighlightingFromNodeWithMessage EmptyRecordInvalidError range error
 
         | MissingErrorNumber ->
-            match error.Message with
-            | x when startsWith expressionIsAFunctionMessage x ->
+            match error.ExtendedData with
+            | Some (:? ExpressionIsAFunctionExtendedData) ->
                 createHighlightingFromMappedExpression getResultExpr FunctionValueUnexpectedWarning range error
 
-            | x when (x.Contains(theModuleContainsTheField) && x.Contains(butItsSignatureSpecifies)) ->
+            | Some (:? FieldNotContainedDiagnosticExtendedData) ->
                 createHighlightingFromParentNodeWithMessage FieldNotContainedTypesDifferError range error
 
-            | Regex typeConstraintMismatchMessage [mismatchedType; typeConstraint] ->
+            | Some (:? TypeMismatchDiagnosticExtendedData as data) ->
                 let highlighting =
-                    match typeConstraint with
+                    match data.ExpectedType.Format(data.DisplayContext) with
                     | "unit" -> createHighlightingFromMappedExpression getResultExpr UnitTypeExpectedError range error
                     | _ -> null
 
                 if isNotNull highlighting then highlighting else
 
                 let expr = nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null)
-                if isNotNull expr then TypeConstraintMismatchError(mismatchedType, expr, error.Message) else null
+                if isNotNull expr then TypeConstraintMismatchError(data.ActualType.Format(data.DisplayContext), expr, error.Message) else null
 
             | _ -> null