@@ -9,6 +9,7 @@ open FSharpLint.Framework.Ast
99open FSharpLint.Framework .Rules
1010open FSharp.Compiler .CodeAnalysis
1111open FSharp.Compiler .Symbols
12+ open FSharp.Compiler .Syntax
1213
1314[<RequireQualifiedAccess>]
1415type 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)
7375let 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
8487let 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+
183346let 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
200369let rule config =
0 commit comments