Skip to content

Commit 5fdbf5d

Browse files
committed
Revert "Revert "Merge PR #653 from webwarrior-ws/partial-functions-value-squashed""
This reverts commit b69b24b because now that we have release 0.24.0 (stable version) we can reintroduce this PR again which causes a regression which we will fix in the next upcoming prereleases.
1 parent b69f1ee commit 5fdbf5d

File tree

2 files changed

+239
-43
lines changed

2 files changed

+239
-43
lines changed

src/FSharpLint.Core/Rules/Conventions/NoPartialFunctions.fs

Lines changed: 212 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ open FSharpLint.Framework.Ast
99
open FSharpLint.Framework.Rules
1010
open FSharp.Compiler.CodeAnalysis
1111
open FSharp.Compiler.Symbols
12+
open FSharp.Compiler.Syntax
1213

1314
[<RequireQualifiedAccess>]
1415
type Config = {
@@ -70,16 +71,18 @@ let private partialFunctionIdentifiers =
7071
("List.pick", Function "List.tryPick")
7172
] |> Map.ofList
7273

74+
/// List of tuples (fully qualified instance member name, namespace, argument compiled type name, replacement strategy)
7375
let private partialInstanceMemberIdentifiers =
7476
[
75-
("Option.Value", PatternMatch)
76-
("Map.Item", Function "Map.tryFind")
77-
("List.Item", Function "List.tryFind")
78-
("List.Head", Function "List.tryHead")
77+
// see https://stackoverflow.com/a/70282499/544947
78+
("Option.Value", Some "Microsoft.FSharp.Core", "option`1", PatternMatch)
79+
("Map.Item", Some "Microsoft.FSharp.Collections", "FSharpMap`2", Function "Map.tryFind")
80+
("List.Item", Some "Microsoft.FSharp.Collections", "list`1", Function "List.tryFind")
81+
("List.Head", Some "Microsoft.FSharp.Collections", "list`1", Function "List.tryHead")
7982

8083
// As an example for future additions (see commented Foo.Bar.Baz tests)
81-
//("Foo.Bar.Baz", PatternMatch)
82-
] |> Map.ofList
84+
//("Foo.Bar.Baz", None, "string", PatternMatch)
85+
]
8386

8487
let private checkIfPartialIdentifier (config:Config) (identifier:string) (range:Range) =
8588
if List.contains identifier config.AllowedPartials then
@@ -110,56 +113,180 @@ let private checkIfPartialIdentifier (config:Config) (identifier:string) (range:
110113
TypeChecks = []
111114
})
112115

113-
let private isNonStaticInstanceMemberCall (checkFile:FSharpCheckFileResults) names range:(Option<WarningDetails>) =
116+
let rec private tryFindTypedExpression (range: Range) (expression: FSharpExpr) =
117+
let tryFindFirst exprs =
118+
exprs |> Seq.choose (tryFindTypedExpression range) |> Seq.tryHead
119+
if expression.Range = range then
120+
Some expression
121+
else
122+
match expression with
123+
| FSharpExprPatterns.AddressOf(lvalueExpr) ->
124+
tryFindTypedExpression range lvalueExpr
125+
| FSharpExprPatterns.AddressSet(lvalueExpr, rvalueExpr) ->
126+
tryFindTypedExpression range lvalueExpr |> Option.orElse (tryFindTypedExpression range rvalueExpr)
127+
| FSharpExprPatterns.Application(funcExpr, _typeArgs, argExprs) ->
128+
(funcExpr :: argExprs) |> tryFindFirst
129+
| FSharpExprPatterns.Call(objExprOpt, _memberOrFunc, _typeArgs1, _typeArgs2, argExprs) ->
130+
(List.append (Option.toList objExprOpt) argExprs) |> tryFindFirst
131+
| FSharpExprPatterns.Coerce(_targetType, inpExpr) ->
132+
tryFindTypedExpression range inpExpr
133+
| FSharpExprPatterns.FastIntegerForLoop(startExpr, limitExpr, consumeExpr, _isUp, _, _) ->
134+
[ startExpr; limitExpr; consumeExpr ] |> tryFindFirst
135+
| FSharpExprPatterns.ILAsm(_asmCode, _typeArgs, argExprs) ->
136+
tryFindFirst argExprs
137+
| FSharpExprPatterns.ILFieldGet (objExprOpt, _fieldType, _fieldName) ->
138+
objExprOpt |> Option.bind (tryFindTypedExpression range)
139+
| FSharpExprPatterns.ILFieldSet (objExprOpt, _fieldType, _fieldName, valueExpr) ->
140+
objExprOpt |> Option.bind (tryFindTypedExpression range) |> Option.orElse (tryFindTypedExpression range valueExpr)
141+
| FSharpExprPatterns.IfThenElse (guardExpr, thenExpr, elseExpr) ->
142+
[ guardExpr; thenExpr; elseExpr ] |> tryFindFirst
143+
| FSharpExprPatterns.Lambda(_lambdaVar, bodyExpr) ->
144+
tryFindTypedExpression range bodyExpr
145+
| FSharpExprPatterns.Let((_bindingVar, bindingExpr, _), bodyExpr) ->
146+
tryFindTypedExpression range bindingExpr |> Option.orElse (tryFindTypedExpression range bodyExpr)
147+
| FSharpExprPatterns.LetRec(recursiveBindings, bodyExpr) ->
148+
recursiveBindings
149+
|> Seq.choose (fun (_, expr, _) -> tryFindTypedExpression range expr)
150+
|> Seq.tryHead
151+
|> Option.orElse (tryFindTypedExpression range bodyExpr)
152+
| FSharpExprPatterns.NewArray(_arrayType, argExprs) ->
153+
tryFindFirst argExprs
154+
| FSharpExprPatterns.NewDelegate(_delegateType, delegateBodyExpr) ->
155+
tryFindTypedExpression range delegateBodyExpr
156+
| FSharpExprPatterns.NewObject(_objType, _typeArgs, argExprs) ->
157+
tryFindFirst argExprs
158+
| FSharpExprPatterns.NewRecord(_recordType, argExprs) ->
159+
tryFindFirst argExprs
160+
| FSharpExprPatterns.NewAnonRecord(_recordType, argExprs) ->
161+
tryFindFirst argExprs
162+
| FSharpExprPatterns.NewTuple(_tupleType, argExprs) ->
163+
tryFindFirst argExprs
164+
| FSharpExprPatterns.NewUnionCase(_unionType, _unionCase, argExprs) ->
165+
tryFindFirst argExprs
166+
| FSharpExprPatterns.Quote(quotedExpr) ->
167+
tryFindTypedExpression range quotedExpr
168+
| FSharpExprPatterns.FSharpFieldGet(objExprOpt, _recordOrClassType, _fieldInfo) ->
169+
objExprOpt |> Option.bind (tryFindTypedExpression range)
170+
| FSharpExprPatterns.AnonRecordGet(objExpr, _recordOrClassType, _fieldInfo) ->
171+
tryFindTypedExpression range objExpr
172+
| FSharpExprPatterns.FSharpFieldSet(objExprOpt, _recordOrClassType, _fieldInfo, argExpr) ->
173+
objExprOpt |> Option.bind (tryFindTypedExpression range) |> Option.orElse (tryFindTypedExpression range argExpr)
174+
| FSharpExprPatterns.Sequential(firstExpr, secondExpr) ->
175+
tryFindTypedExpression range firstExpr |> Option.orElse (tryFindTypedExpression range secondExpr)
176+
| FSharpExprPatterns.TryFinally(bodyExpr, finalizeExpr, _, _) ->
177+
tryFindTypedExpression range bodyExpr |> Option.orElse (tryFindTypedExpression range finalizeExpr)
178+
| FSharpExprPatterns.TryWith(bodyExpr, _, _, _catchVar, catchExpr, _, _) ->
179+
tryFindTypedExpression range bodyExpr |> Option.orElse (tryFindTypedExpression range catchExpr)
180+
| FSharpExprPatterns.TupleGet(_tupleType, _tupleElemIndex, tupleExpr) ->
181+
tryFindTypedExpression range tupleExpr
182+
| FSharpExprPatterns.DecisionTree(decisionExpr, decisionTargets) ->
183+
tryFindTypedExpression range decisionExpr
184+
|> Option.orElse (decisionTargets |> Seq.choose (fun (_, expr) -> tryFindTypedExpression range expr) |> Seq.tryHead)
185+
| FSharpExprPatterns.DecisionTreeSuccess (_decisionTargetIdx, decisionTargetExprs) ->
186+
tryFindFirst decisionTargetExprs
187+
| FSharpExprPatterns.TypeLambda(_genericParam, bodyExpr) ->
188+
tryFindTypedExpression range bodyExpr
189+
| FSharpExprPatterns.TypeTest(_ty, inpExpr) ->
190+
tryFindTypedExpression range inpExpr
191+
| FSharpExprPatterns.UnionCaseSet(unionExpr, unionType, unionCase, unionCaseField, valueExpr) ->
192+
tryFindTypedExpression range unionExpr |> Option.orElse (tryFindTypedExpression range valueExpr)
193+
| FSharpExprPatterns.UnionCaseGet(unionExpr, _unionType, _unionCase, _unionCaseField) ->
194+
tryFindTypedExpression range unionExpr
195+
| FSharpExprPatterns.UnionCaseTest(unionExpr, _unionType, _unionCase) ->
196+
tryFindTypedExpression range unionExpr
197+
| FSharpExprPatterns.UnionCaseTag(unionExpr, _unionType) ->
198+
tryFindTypedExpression range unionExpr
199+
| FSharpExprPatterns.ObjectExpr(_objType, baseCallExpr, overrides, interfaceImplementations) ->
200+
let interfaceImlps = interfaceImplementations |> List.collect snd
201+
baseCallExpr :: (List.append overrides interfaceImlps |> Seq.cast<FSharpExpr> |> Seq.toList)
202+
|> tryFindFirst
203+
| FSharpExprPatterns.TraitCall(_sourceTypes, _traitName, _typeArgs, _typeInstantiation, _argTypes, argExprs) ->
204+
tryFindFirst argExprs
205+
| FSharpExprPatterns.ValueSet(_valToSet, valueExpr) ->
206+
tryFindTypedExpression range valueExpr
207+
| FSharpExprPatterns.WhileLoop(guardExpr, bodyExpr, _) ->
208+
tryFindTypedExpression range guardExpr |> Option.orElse (tryFindTypedExpression range bodyExpr)
209+
| _ -> None
210+
211+
let private getTypedExpressionForRange (checkFile:FSharpCheckFileResults) (range: Range) =
212+
let expressions =
213+
match checkFile.ImplementationFile with
214+
| Some implementationFile ->
215+
let rec getExpressions declarations =
216+
seq {
217+
for declaration in declarations do
218+
match declaration with
219+
| FSharpImplementationFileDeclaration.Entity(entity, subDecls) ->
220+
yield! getExpressions subDecls
221+
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(_,_,body) ->
222+
yield body
223+
| _ -> ()
224+
}
225+
226+
getExpressions implementationFile.Declarations
227+
| None -> Seq.empty
228+
229+
expressions
230+
|> Seq.choose (tryFindTypedExpression range)
231+
|> Seq.tryHead
232+
233+
let private matchesBuiltinFSharpType (typeName: string) (fsharpType: FSharpType) : Option<bool> =
234+
let matchingPartialInstanceMember =
235+
partialInstanceMemberIdentifiers
236+
|> List.tryFind (fun (memberName, _, _, _) -> memberName.Split('.').[0] = typeName)
237+
238+
match matchingPartialInstanceMember with
239+
| Some(_, typeNamespace, compiledTypeName, _) ->
240+
(fsharpType.HasTypeDefinition
241+
&& fsharpType.TypeDefinition.Namespace = typeNamespace
242+
&& fsharpType.TypeDefinition.CompiledName = compiledTypeName)
243+
|> Some
244+
| None -> None
114245

246+
let private isNonStaticInstanceMemberCall (checkFile:FSharpCheckFileResults) names lineText (range: Range) :(Option<WarningDetails>) =
115247
let typeChecks =
116248
(partialInstanceMemberIdentifiers
117-
|> Map.toList
118249
|> List.map (fun replacement ->
119250
match replacement with
120-
| (fullyQualifiedInstanceMember, replacementStrategy) ->
251+
| (fullyQualifiedInstanceMember, _, _, replacementStrategy) ->
121252
if not (fullyQualifiedInstanceMember.Contains ".") then
122253
failwith "Please use fully qualified name for the instance member"
123254
let nameSegments = fullyQualifiedInstanceMember.Split '.'
124255
let instanceMemberNameOnly = Array.last nameSegments
125256
let isSourcePropSameAsReplacementProp = List.tryFind (fun sourceInstanceMemberName -> sourceInstanceMemberName = instanceMemberNameOnly) names
126257
match isSourcePropSameAsReplacementProp with
127258
| Some _ ->
128-
let typeName = fullyQualifiedInstanceMember.Substring(0, fullyQualifiedInstanceMember.Length - instanceMemberNameOnly.Length - 1)
129-
let partialAssemblySignature = checkFile.PartialAssemblySignature
259+
let typeName = fullyQualifiedInstanceMember.Substring(0, fullyQualifiedInstanceMember.Length - instanceMemberNameOnly.Length - 1)
130260

131-
let isEntityOfType (entity:FSharpEntity) =
132-
match entity.TryFullName with
133-
| Some name when name = typeName -> true
134-
| _ -> false
261+
let instanceIdentifier =
262+
String.concat
263+
"."
264+
(List.takeWhile
265+
(fun sourceInstanceMemberName -> sourceInstanceMemberName <> instanceMemberNameOnly)
266+
names)
267+
268+
let instanceIdentifierSymbol =
269+
let maybeSymbolUse =
270+
checkFile.GetSymbolUseAtLocation(
271+
range.EndLine,
272+
range.EndColumn - ((String.concat "." names).Length - instanceIdentifier.Length),
273+
lineText,
274+
List.singleton instanceIdentifier)
275+
match maybeSymbolUse with
276+
| Some symbolUse ->
277+
match symbolUse.Symbol with
278+
| :? FSharpMemberOrFunctionOrValue as symbol -> Some symbol
279+
| _ -> None
280+
| _ -> None
281+
282+
match instanceIdentifierSymbol with
283+
| Some identifierSymbol ->
284+
let typeMatches =
285+
let fsharpType = identifierSymbol.FullType
286+
match matchesBuiltinFSharpType typeName fsharpType with
287+
| Some value -> value
288+
| None -> identifierSymbol.FullType.TypeDefinition.FullName = typeName
135289

136-
let entityForType =
137-
if partialAssemblySignature.Entities.Count > 1 then
138-
Seq.tryFind isEntityOfType partialAssemblySignature.Entities
139-
else
140-
Some partialAssemblySignature.Entities.[0]
141-
142-
match entityForType with
143-
| Some moduleEnt ->
144-
let getFunctionValTypeName (fnVal:FSharpMemberOrFunctionOrValue) =
145-
let fsharpType = fnVal.FullType
146-
match typeName with
147-
| "Option" ->
148-
// see https://stackoverflow.com/a/70282499/544947
149-
fsharpType.HasTypeDefinition
150-
&& fsharpType.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core"
151-
&& fsharpType.TypeDefinition.CompiledName = "option`1"
152-
| "Map" ->
153-
fsharpType.HasTypeDefinition
154-
&& fsharpType.TypeDefinition.Namespace = Some "Microsoft.FSharp.Collections"
155-
&& fsharpType.TypeDefinition.CompiledName = "FSharpMap`2"
156-
| "List" ->
157-
fsharpType.HasTypeDefinition
158-
&& fsharpType.TypeDefinition.Namespace = Some "Microsoft.FSharp.Collections"
159-
&& fsharpType.TypeDefinition.CompiledName = "list`1"
160-
| _ -> fnVal.FullName = typeName
161-
162-
let typeMatches = moduleEnt.MembersFunctionsAndValues.Any(Func<FSharpMemberOrFunctionOrValue, bool>(getFunctionValTypeName))
163290
if typeMatches then
164291
match replacementStrategy with
165292
| PatternMatch ->
@@ -180,6 +307,42 @@ let private isNonStaticInstanceMemberCall (checkFile:FSharpCheckFileResults) nam
180307
| None -> None
181308
| Some instanceMember -> instanceMember
182309

310+
let private checkMemberCallOnExpression
311+
(checkFile: FSharpCheckFileResults)
312+
(flieContent: string)
313+
(range: Range)
314+
(originalRange: Range): array<WarningDetails> =
315+
match getTypedExpressionForRange checkFile range with
316+
| Some expression ->
317+
partialInstanceMemberIdentifiers
318+
|> List.choose (fun (fullyQualifiedInstanceMember, _, _, replacementStrategy) ->
319+
let typeName = fullyQualifiedInstanceMember.Split(".").[0]
320+
let fsharpType = expression.Type
321+
322+
let matchesType =
323+
match matchesBuiltinFSharpType typeName fsharpType with
324+
| Some value -> value
325+
| None ->
326+
fsharpType.HasTypeDefinition
327+
&& fsharpType.TypeDefinition.FullName = typeName
328+
329+
if matchesType then
330+
match replacementStrategy with
331+
| PatternMatch ->
332+
Some { Range = originalRange
333+
Message = String.Format(Resources.GetString "RulesConventionsNoPartialFunctionsPatternMatchError", fullyQualifiedInstanceMember)
334+
SuggestedFix = None
335+
TypeChecks = (fun () -> true) |> List.singleton }
336+
| Function replacementFunctionName ->
337+
Some { Range = originalRange
338+
Message = String.Format(Resources.GetString "RulesConventionsNoPartialFunctionsReplacementError", replacementFunctionName, fullyQualifiedInstanceMember)
339+
SuggestedFix = Some (lazy ( Some { FromText = (ExpressionUtilities.tryFindTextOfRange originalRange flieContent).Value ; FromRange = originalRange; ToText = replacementFunctionName }))
340+
TypeChecks = (fun () -> true) |> List.singleton }
341+
else
342+
None)
343+
|> List.toArray
344+
| None -> Array.empty
345+
183346
let private runner (config:Config) (args:AstNodeRuleParams) =
184347
match (args.AstNode, args.CheckInfo) with
185348
| (AstNode.Identifier (identifier, range), Some checkInfo) ->
@@ -190,11 +353,17 @@ let private runner (config:Config) (args:AstNodeRuleParams) =
190353
| Some partialIdent ->
191354
partialIdent |> Array.singleton
192355
| _ ->
193-
let nonStaticInstanceMemberTypeCheckResult = isNonStaticInstanceMemberCall checkInfo identifier range
356+
let lineText = args.Lines.[range.EndLine - 1]
357+
let nonStaticInstanceMemberTypeCheckResult = isNonStaticInstanceMemberCall checkInfo identifier lineText range
194358
match nonStaticInstanceMemberTypeCheckResult with
195359
| Some warningDetails ->
196360
warningDetails |> Array.singleton
197361
| _ -> Array.Empty()
362+
| (Ast.Expression(SynExpr.DotGet(expr, _, SynLongIdent(_identifiers, _, _), _range)), Some checkInfo) ->
363+
let originalRange = expr.Range
364+
let expr = ExpressionUtilities.removeParens expr
365+
366+
checkMemberCallOnExpression checkInfo args.FileContent expr.Range originalRange
198367
| _ -> Array.empty
199368

200369
let rule config =

tests/FSharpLint.Core.Tests/Rules/Conventions/NoPartialFunctions.fs

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,33 @@ module Program =
6262
Assert.IsTrue(this.ErrorExistsAt(7, 34))
6363
this.AssertErrorWithMessageExists("Consider using pattern matching instead of partial function/method 'Option.Value'.")
6464

65+
[<Test>]
66+
member this.``No error for calling Value on ref type (regression)``() =
67+
this.Parse("""
68+
namespace Foo
69+
module Program =
70+
let foo = None
71+
let bar = ref 0
72+
73+
let printFoo() =
74+
System.Console.WriteLine (bar.Value.ToString())""")
75+
76+
Assert.IsTrue this.NoErrorsExist
77+
78+
[<Test>]
79+
member this.``Error for Option.Value (List.tryHead test case)``() =
80+
this.Parse("""
81+
namespace Foo
82+
module Program =
83+
let foo = []
84+
85+
let printFoo() =
86+
System.Console.WriteLine ((List.tryHead foo).Value.ToString())""")
87+
88+
Assert.IsTrue this.ErrorsExist
89+
Assert.IsTrue(this.ErrorExistsAt(7, 34))
90+
this.AssertErrorWithMessageExists("Consider using pattern matching instead of partial function/method 'Option.Value'.")
91+
6592
[<Test>]
6693
member this.``No error for value property in DU``() =
6794
this.Parse("

0 commit comments

Comments
 (0)