From 6f870cccd05baaff9c81b19a1d87730ae6880a00 Mon Sep 17 00:00:00 2001 From: cartermp Date: Thu, 18 Jun 2020 21:23:22 -0700 Subject: [PATCH 01/16] First go at updated classifications --- src/fsharp/service/SemanticClassification.fs | 80 +++++++++++++++---- src/fsharp/service/SemanticClassification.fsi | 4 + .../ClassificationDefinitions.fs | 77 ++++++++---------- 3 files changed, 101 insertions(+), 60 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 367d2290122..9a4429b0488 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -36,6 +36,10 @@ type SemanticClassificationType = | TypeArgument | Operator | Disposable + | Method + | Constructor + | Literal + | RecordField [] module TcResolutionsExtensions = @@ -89,6 +93,9 @@ module TcResolutionsExtensions = let isDisposableTy (ty: TType) = protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) + let isValRefDisposable (vref: ValRef) = + not (vref.DisplayName = "_") && not (vref.DisplayName = "__") && isDisposableTy vref.Type + let isStructTyconRef (tyconRef: TyconRef) = let ty = generalizedTyconRef tyconRef let underlyingTy = stripTyEqnsAndMeasureEqns g ty @@ -116,61 +123,100 @@ module TcResolutionsExtensions = // 'seq' in 'seq { ... }' gets colored as keywords | (Item.Value vref), ItemOccurence.Use, _, _, _, m when valRefEq g g.seq_vref vref -> add m SemanticClassificationType.ComputationExpression + | (Item.Value vref), _, _, _, _, m when isValRefMutable vref -> add m SemanticClassificationType.MutableVar + | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, _, _, _, m -> add m SemanticClassificationType.IntrinsicFunction + + | (Item.Value vref), _, _, _, _, m when Option.isSome vref.LiteralValue -> + add m SemanticClassificationType.Literal + | (Item.Value vref), _, _, _, _, m when isFunction g vref.Type -> if valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then () elif vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then add m SemanticClassificationType.Property + elif vref.IsMember then + add m SemanticClassificationType.Method elif IsOperatorName vref.DisplayName then add m SemanticClassificationType.Operator else add m SemanticClassificationType.Function - | Item.RecdField rfinfo, _, _, _, _, m when isRecdFieldMutable rfinfo -> - add m SemanticClassificationType.MutableVar - | Item.RecdField rfinfo, _, _, _, _, m when isFunction g rfinfo.FieldType -> - add m SemanticClassificationType.Function - | Item.RecdField EnumCaseFieldInfo, _, _, _, _, m -> - add m SemanticClassificationType.Enumeration + + | (Item.Value vref), _, _, _, _, m when isValRefDisposable vref -> + add m SemanticClassificationType.Disposable + + | Item.RecdField rfinfo, _, _, _, _, m -> + match rfinfo with + | EnumCaseFieldInfo -> + add m SemanticClassificationType.Enumeration + | _ -> + if isRecdFieldMutable rfinfo then + add m SemanticClassificationType.MutableVar + else + add m SemanticClassificationType.RecordField + + | Item.AnonRecdField(_, tys, idx, m), _, _, _, _, _ -> + let ty = tys.[idx] + if isRefCellTy g ty then + add m SemanticClassificationType.MutableVar + else + add m SemanticClassificationType.RecordField + | Item.MethodGroup _, _, _, _, _, m -> - add m SemanticClassificationType.Function - // custom builders, custom operations get colored as keywords + add m SemanticClassificationType.Method + + | Item.CtorGroup _, _, _, _, _, m -> + add m SemanticClassificationType.Constructor + + | Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _ -> + () + + // Custom builders, custom operations get colored as keywords | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m -> add m SemanticClassificationType.ComputationExpression - // types get colored as types when they occur in syntactic types or custom attributes - // type variables get colored as types when they occur in syntactic types custom builders, custom operations get colored as keywords - | Item.Types (_, [OptionalArgumentAttribute]), LegitTypeOccurence, _, _, _, _ -> () - | Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _ -> () + + // Types get colored as types when they occur in syntactic types or custom attributes + // Type variables get colored as types when they occur in syntactic types custom builders, custom operations get colored as keywords + | Item.Types (_, [OptionalArgumentAttribute]), LegitTypeOccurence, _, _, _, _ -> + () + | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isInterfaceTy g) -> add m SemanticClassificationType.Interface + | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isStructTy g) -> add m SemanticClassificationType.ValueType + | Item.Types(_, TType_app(tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, _, _, _, m when isStructTyconRef tyconRef -> add m SemanticClassificationType.ValueType + | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists isDisposableTy -> add m SemanticClassificationType.Disposable + | Item.Types _, LegitTypeOccurence, _, _, _, m -> add m SemanticClassificationType.ReferenceType + | (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m -> add m SemanticClassificationType.TypeArgument + | Item.UnqualifiedType tyconRefs, LegitTypeOccurence, _, _, _, m -> if tyconRefs |> List.exists (fun tyconRef -> tyconRef.Deref.IsStructOrEnumTycon) then add m SemanticClassificationType.ValueType else add m SemanticClassificationType.ReferenceType - | Item.CtorGroup(_, minfos), LegitTypeOccurence, _, _, _, m -> - if minfos |> List.exists (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then - add m SemanticClassificationType.ValueType - else add m SemanticClassificationType.ReferenceType + | Item.ExnCase _, LegitTypeOccurence, _, _, _, m -> add m SemanticClassificationType.ReferenceType + | Item.ModuleOrNamespaces refs, LegitTypeOccurence, _, _, _, m when refs |> List.exists (fun x -> x.IsModule) -> add m SemanticClassificationType.Module + | (Item.ActivePatternCase _ | Item.UnionCase _ | Item.ActivePatternResult _), _, _, _, _, m -> add m SemanticClassificationType.UnionCase - | _ -> ()) + + | _ -> + ()) results.AddRange(formatSpecifierLocations |> Array.map (fun (m, _) -> struct(m, SemanticClassificationType.Printf))) results.ToArray() ) diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index ff0e89a29f8..2bc988e4824 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -28,6 +28,10 @@ type SemanticClassificationType = | TypeArgument | Operator | Disposable + | Method + | Constructor + | Literal + | RecordField /// Extension methods for the TcResolutions type. [] diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 749c3ceed7a..d14f55c189f 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -24,33 +24,29 @@ module internal FSharpClassificationTypes = let [] Function = "FSharp.Function" let [] MutableVar = "FSharp.MutableVar" let [] Printf = "FSharp.Printf" - let [] ReferenceType = ClassificationTypeNames.ClassName - let [] Module = ClassificationTypeNames.ModuleName - let [] ValueType = ClassificationTypeNames.StructName - let [] Keyword = ClassificationTypeNames.Keyword - let [] Enum = ClassificationTypeNames.EnumName - let [] Property = "FSharp.Property" - let [] Interface = ClassificationTypeNames.InterfaceName - let [] TypeArgument = ClassificationTypeNames.TypeParameterName - let [] Operator = ClassificationTypeNames.Operator let [] Disposable = "FSharp.Disposable" + let [] RecordField = "FSharp.RecordField" let getClassificationTypeName = function - | SemanticClassificationType.ReferenceType -> ReferenceType - | SemanticClassificationType.Module -> Module - | SemanticClassificationType.ValueType -> ValueType | SemanticClassificationType.Function -> Function | SemanticClassificationType.MutableVar -> MutableVar | SemanticClassificationType.Printf -> Printf + | SemanticClassificationType.Disposable -> Disposable + | SemanticClassificationType.ReferenceType -> ClassificationTypeNames.ClassName + | SemanticClassificationType.Module -> ClassificationTypeNames.ModuleName + | SemanticClassificationType.ValueType -> ClassificationTypeNames.StructName | SemanticClassificationType.ComputationExpression - | SemanticClassificationType.IntrinsicFunction -> Keyword + | SemanticClassificationType.IntrinsicFunction -> ClassificationTypeNames.Keyword | SemanticClassificationType.UnionCase - | SemanticClassificationType.Enumeration -> Enum - | SemanticClassificationType.Property -> Property - | SemanticClassificationType.Interface -> Interface - | SemanticClassificationType.TypeArgument -> TypeArgument - | SemanticClassificationType.Operator -> Operator - | SemanticClassificationType.Disposable -> Disposable + | SemanticClassificationType.Enumeration -> ClassificationTypeNames.EnumName + | SemanticClassificationType.Property -> ClassificationTypeNames.PropertyName + | SemanticClassificationType.Interface -> ClassificationTypeNames.InterfaceName + | SemanticClassificationType.TypeArgument -> ClassificationTypeNames.TypeParameterName + | SemanticClassificationType.Operator -> ClassificationTypeNames.Operator + | SemanticClassificationType.Constructor + | SemanticClassificationType.Method -> ClassificationTypeNames.MethodName + | SemanticClassificationType.Literal -> ClassificationTypeNames.ConstantName + | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName module internal ClassificationDefinitions = @@ -73,13 +69,13 @@ module internal ClassificationDefinitions = let themeService = serviceProvider.GetService(typeof) :?> IVsColorThemeService themeService.CurrentTheme.ThemeId - let colorData = // name, (light, dark) - [ FSharpClassificationTypes.Function, (Colors.Black, Color.FromRgb(220uy, 220uy, 220uy)) - FSharpClassificationTypes.MutableVar, (Color.FromRgb(160uy, 128uy, 0uy), Color.FromRgb(255uy, 210uy, 28uy)) - FSharpClassificationTypes.Printf, (Color.FromRgb(43uy, 145uy, 175uy), Color.FromRgb(78uy, 220uy, 176uy)) - FSharpClassificationTypes.Property, (Colors.Black, Color.FromRgb(220uy, 220uy, 220uy)) - FSharpClassificationTypes.Disposable, (Color.FromRgb(43uy, 145uy, 175uy), Color.FromRgb(78uy, 220uy, 176uy)) ] - + let colorData = // name, (light, dark) + [ + FSharpClassificationTypes.Function, (Colors.Black, Color.FromRgb(220uy, 220uy, 220uy)) + FSharpClassificationTypes.MutableVar, (Color.FromRgb(160uy, 128uy, 0uy), Color.FromRgb(255uy, 210uy, 28uy)) + FSharpClassificationTypes.Printf, (Color.FromRgb(43uy, 145uy, 175uy), Color.FromRgb(78uy, 220uy, 176uy)) + FSharpClassificationTypes.Disposable, (Colors.ForestGreen, Colors.ForestGreen) + ] let setColors _ = let fontAndColorStorage = serviceProvider.GetService(typeof) :?> IVsFontAndColorStorage @@ -95,10 +91,18 @@ module internal ClassificationDefinitions = if fontAndColorStorage.GetItem(ctype, Array.zeroCreate 1) <> VSConstants.S_OK then let ict = classificationTypeRegistry.GetClassificationType(ctype) let oldProps = formatMap.GetTextProperties(ict) - let newProps = match getCurrentThemeId() with - | LightTheme -> oldProps.SetForeground light - | DarkTheme -> oldProps.SetForeground dark - | UnknownTheme -> oldProps + let newProps = + let props = + match getCurrentThemeId() with + | LightTheme -> oldProps.SetForeground light + | DarkTheme -> oldProps.SetForeground dark + | UnknownTheme -> oldProps + + // Distinguish F# functions from values with bold + if ctype = FSharpClassificationTypes.Function then + props.SetBold(true) + else + props formatMap.SetTextProperties(ict, newProps) fontAndColorStorage.CloseCategory() |> ignore finally formatMap.EndBatchUpdate() @@ -126,9 +130,6 @@ module internal ClassificationDefinitions = [] let FSharpPrintfClassificationType : ClassificationTypeDefinition = null - [] - let FSharpPropertyClassificationType : ClassificationTypeDefinition = null - [] let FSharpDisposableClassificationType : ClassificationTypeDefinition = null @@ -164,16 +165,6 @@ module internal ClassificationDefinitions = do self.DisplayName <- SR.FSharpPrintfFormatClassificationType() self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.Printf - [)>] - [] - [] - [] - [] - type internal FSharpPropertyFormat() as self = - inherit ClassificationFormatDefinition() - - do self.DisplayName <- SR.FSharpPropertiesClassificationType() - [)>] [] [] From 8331b39011de924d684efa4714710ee819121302 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 00:20:07 -0700 Subject: [PATCH 02/16] More complete classification --- src/fsharp/service/SemanticClassification.fs | 99 +++++++++++++++---- src/fsharp/service/SemanticClassification.fsi | 13 ++- .../ClassificationDefinitions.fs | 17 +++- 3 files changed, 103 insertions(+), 26 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 9a4429b0488..fd6997b8e57 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -10,7 +10,6 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.Infos open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Lib open FSharp.Compiler.NameResolution open FSharp.Compiler.PrettyNaming open FSharp.Compiler.Range @@ -24,10 +23,12 @@ type SemanticClassificationType = | ReferenceType | ValueType | UnionCase + | UnionCaseField | Function | Property | MutableVar | Module + | NameSpace | Printf | ComputationExpression | IntrinsicFunction @@ -35,11 +36,19 @@ type SemanticClassificationType = | Interface | TypeArgument | Operator - | Disposable + | DisposableType + | DisposableValue | Method + | ExtensionMethod | Constructor | Literal | RecordField + | MutableRecordField + | RecordFieldAsFunction + | ExceptionCase + | Field + | Event + | Delegate [] module TcResolutionsExtensions = @@ -146,7 +155,7 @@ module TcResolutionsExtensions = add m SemanticClassificationType.Function | (Item.Value vref), _, _, _, _, m when isValRefDisposable vref -> - add m SemanticClassificationType.Disposable + add m SemanticClassificationType.DisposableValue | Item.RecdField rfinfo, _, _, _, _, m -> match rfinfo with @@ -154,25 +163,37 @@ module TcResolutionsExtensions = add m SemanticClassificationType.Enumeration | _ -> if isRecdFieldMutable rfinfo then - add m SemanticClassificationType.MutableVar + add m SemanticClassificationType.MutableRecordField + elif isFunTy g rfinfo.FieldType then + add m SemanticClassificationType.RecordFieldAsFunction else add m SemanticClassificationType.RecordField | Item.AnonRecdField(_, tys, idx, m), _, _, _, _, _ -> let ty = tys.[idx] + + // It's not currently possible for anon record fields to be mutable, but they can be ref cells if isRefCellTy g ty then - add m SemanticClassificationType.MutableVar + add m SemanticClassificationType.MutableRecordField + elif isFunTy g ty then + add m SemanticClassificationType.RecordFieldAsFunction else add m SemanticClassificationType.RecordField - | Item.MethodGroup _, _, _, _, _, m -> - add m SemanticClassificationType.Method - - | Item.CtorGroup _, _, _, _, _, m -> - add m SemanticClassificationType.Constructor + | Item.Property _, _, _, _, _, m -> + add m SemanticClassificationType.Property | Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _ -> () + + | (Item.CtorGroup _ | Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m -> + add m SemanticClassificationType.Constructor + + | Item.MethodGroup (_, minfos, _), _, _, _, _, m -> + if minfos |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then + add m SemanticClassificationType.ExtensionMethod + else + add m SemanticClassificationType.Method // Custom builders, custom operations get colored as keywords | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m -> @@ -193,28 +214,66 @@ module TcResolutionsExtensions = add m SemanticClassificationType.ValueType | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists isDisposableTy -> - add m SemanticClassificationType.Disposable + add m SemanticClassificationType.DisposableType - | Item.Types _, LegitTypeOccurence, _, _, _, m -> + | Item.Types _, LegitTypeOccurence, _, _, _, m -> add m SemanticClassificationType.ReferenceType | (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m -> add m SemanticClassificationType.TypeArgument - | Item.UnqualifiedType tyconRefs, LegitTypeOccurence, _, _, _, m -> - if tyconRefs |> List.exists (fun tyconRef -> tyconRef.Deref.IsStructOrEnumTycon) then - add m SemanticClassificationType.ValueType - else add m SemanticClassificationType.ReferenceType - | Item.ExnCase _, LegitTypeOccurence, _, _, _, m -> - add m SemanticClassificationType.ReferenceType + add m SemanticClassificationType.ExceptionCase - | Item.ModuleOrNamespaces refs, LegitTypeOccurence, _, _, _, m when refs |> List.exists (fun x -> x.IsModule) -> - add m SemanticClassificationType.Module + | Item.ModuleOrNamespaces (modref :: _), LegitTypeOccurence, _, _, _, m -> + if modref.IsNamespace then + add m SemanticClassificationType.NameSpace + else + add m SemanticClassificationType.Module | (Item.ActivePatternCase _ | Item.UnionCase _ | Item.ActivePatternResult _), _, _, _, _, m -> add m SemanticClassificationType.UnionCase + | Item.UnionCaseField _, _, _, _, _, m -> + add m SemanticClassificationType.UnionCaseField + + | Item.ILField _, _, _, _, _, m -> + add m SemanticClassificationType.Field + + | Item.Event _, _, _, _, _, m -> + add m SemanticClassificationType.Event + + | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m -> + if tcref.IsEnumTycon || tcref.IsILEnumTycon then + add m SemanticClassificationType.Enumeration + elif tcref.IsExceptionDecl then + add m SemanticClassificationType.ExceptionCase // Todo, differentiate? + elif tcref.IsFSharpDelegateTycon then + add m SemanticClassificationType.Delegate + elif tcref.IsFSharpInterfaceTycon then + add m SemanticClassificationType.Interface + elif tcref.IsFSharpStructOrEnumTycon then + add m SemanticClassificationType.ValueType + elif tcref.IsModule then + add m SemanticClassificationType.Module + elif tcref.IsNamespace then + add m SemanticClassificationType.NameSpace + elif tcref.IsUnionTycon then + add m SemanticClassificationType.UnionCase // Todo, differentiate? + elif tcref.IsILTycon then + let (TILObjectReprData (_, _, tydef)) = tcref.ILTyconInfo + + if tydef.IsInterface then + add m SemanticClassificationType.Interface + elif tydef.IsDelegate then + add m SemanticClassificationType.Delegate + elif tydef.IsEnum then + add m SemanticClassificationType.Enumeration + elif tydef.IsStruct then + add m SemanticClassificationType.ValueType + else + add m SemanticClassificationType.ReferenceType + | _ -> ()) results.AddRange(formatSpecifierLocations |> Array.map (fun (m, _) -> struct(m, SemanticClassificationType.Printf))) diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 2bc988e4824..313f3c97e0e 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -2,7 +2,6 @@ namespace FSharp.Compiler.SourceCodeServices -open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Import open FSharp.Compiler.NameResolution @@ -16,10 +15,12 @@ type SemanticClassificationType = | ReferenceType | ValueType | UnionCase + | UnionCaseField | Function | Property | MutableVar | Module + | NameSpace | Printf | ComputationExpression | IntrinsicFunction @@ -27,11 +28,19 @@ type SemanticClassificationType = | Interface | TypeArgument | Operator - | Disposable + | DisposableType + | DisposableValue | Method + | ExtensionMethod | Constructor | Literal | RecordField + | MutableRecordField + | RecordFieldAsFunction + | ExceptionCase + | Field + | Event + | Delegate /// Extension methods for the TcResolutions type. [] diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index d14f55c189f..250695c7069 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -25,28 +25,37 @@ module internal FSharpClassificationTypes = let [] MutableVar = "FSharp.MutableVar" let [] Printf = "FSharp.Printf" let [] Disposable = "FSharp.Disposable" - let [] RecordField = "FSharp.RecordField" let getClassificationTypeName = function | SemanticClassificationType.Function -> Function + | SemanticClassificationType.MutableRecordField | SemanticClassificationType.MutableVar -> MutableVar | SemanticClassificationType.Printf -> Printf - | SemanticClassificationType.Disposable -> Disposable + | SemanticClassificationType.DisposableValue + | SemanticClassificationType.DisposableType -> Disposable + | SemanticClassificationType.NameSpace -> ClassificationTypeNames.NamespaceName + | SemanticClassificationType.ExceptionCase + | SemanticClassificationType.Module | SemanticClassificationType.ReferenceType -> ClassificationTypeNames.ClassName - | SemanticClassificationType.Module -> ClassificationTypeNames.ModuleName | SemanticClassificationType.ValueType -> ClassificationTypeNames.StructName | SemanticClassificationType.ComputationExpression | SemanticClassificationType.IntrinsicFunction -> ClassificationTypeNames.Keyword | SemanticClassificationType.UnionCase | SemanticClassificationType.Enumeration -> ClassificationTypeNames.EnumName + | SemanticClassificationType.Field + | SemanticClassificationType.UnionCaseField -> ClassificationTypeNames.FieldName | SemanticClassificationType.Property -> ClassificationTypeNames.PropertyName | SemanticClassificationType.Interface -> ClassificationTypeNames.InterfaceName | SemanticClassificationType.TypeArgument -> ClassificationTypeNames.TypeParameterName | SemanticClassificationType.Operator -> ClassificationTypeNames.Operator | SemanticClassificationType.Constructor | SemanticClassificationType.Method -> ClassificationTypeNames.MethodName + | SemanticClassificationType.ExtensionMethod -> ClassificationTypeNames.ExtensionMethodName | SemanticClassificationType.Literal -> ClassificationTypeNames.ConstantName + | SemanticClassificationType.RecordFieldAsFunction | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName + | SemanticClassificationType.Event -> ClassificationTypeNames.EventName + | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName module internal ClassificationDefinitions = @@ -74,7 +83,7 @@ module internal ClassificationDefinitions = FSharpClassificationTypes.Function, (Colors.Black, Color.FromRgb(220uy, 220uy, 220uy)) FSharpClassificationTypes.MutableVar, (Color.FromRgb(160uy, 128uy, 0uy), Color.FromRgb(255uy, 210uy, 28uy)) FSharpClassificationTypes.Printf, (Color.FromRgb(43uy, 145uy, 175uy), Color.FromRgb(78uy, 220uy, 176uy)) - FSharpClassificationTypes.Disposable, (Colors.ForestGreen, Colors.ForestGreen) + FSharpClassificationTypes.Disposable, (Colors.Tomato, Colors.Tomato) ] let setColors _ = From 83e706ef15326e5eca1a5a2d2682993d023ed432 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 11:22:38 -0700 Subject: [PATCH 03/16] More accurate classification that roughly matches glyph computations --- src/fsharp/service/SemanticClassification.fs | 118 ++++++++++++------ src/fsharp/service/SemanticClassification.fsi | 9 +- .../ClassificationDefinitions.fs | 27 ++-- 3 files changed, 99 insertions(+), 55 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index fd6997b8e57..bc103affabd 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -45,22 +45,24 @@ type SemanticClassificationType = | RecordField | MutableRecordField | RecordFieldAsFunction - | ExceptionCase + | Exception | Field | Event | Delegate + | NamedArgument + | Value + | Type + | TypeDef + | Measure [] module TcResolutionsExtensions = - let (|CNR|) (cnr:CapturedNameResolution) = (cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) type TcResolutions with - member sResolutions.GetSemanticClassification(g: TcGlobals, amap: Import.ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : struct(range * SemanticClassificationType) [] = - ErrorScope.Protect Range.range0 - (fun () -> + ErrorScope.Protect Range.range0 (fun () -> let (|LegitTypeOccurence|_|) = function | ItemOccurence.UseInType | ItemOccurence.UseInAttribute @@ -76,11 +78,11 @@ module TcResolutionsExtensions = let (|KeywordIntrinsicValue|_|) (vref: ValRef) = if valRefEq g g.raise_vref vref || - valRefEq g g.reraise_vref vref || - valRefEq g g.typeof_vref vref || - valRefEq g g.typedefof_vref vref || - valRefEq g g.sizeof_vref vref || - valRefEq g g.nameof_vref vref then Some() + valRefEq g g.reraise_vref vref || + valRefEq g g.typeof_vref vref || + valRefEq g g.typedefof_vref vref || + valRefEq g g.sizeof_vref vref || + valRefEq g g.nameof_vref vref then Some() else None let (|EnumCaseFieldInfo|_|) (rfinfo : RecdFieldInfo) = @@ -157,6 +159,9 @@ module TcResolutionsExtensions = | (Item.Value vref), _, _, _, _, m when isValRefDisposable vref -> add m SemanticClassificationType.DisposableValue + | Item.Value _, _, _, _, _, m -> + add m SemanticClassificationType.Value + | Item.RecdField rfinfo, _, _, _, _, m -> match rfinfo with | EnumCaseFieldInfo -> @@ -183,9 +188,6 @@ module TcResolutionsExtensions = | Item.Property _, _, _, _, _, m -> add m SemanticClassificationType.Property - | Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _ -> - () - | (Item.CtorGroup _ | Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m -> add m SemanticClassificationType.Constructor @@ -195,35 +197,71 @@ module TcResolutionsExtensions = else add m SemanticClassificationType.Method - // Custom builders, custom operations get colored as keywords | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m -> add m SemanticClassificationType.ComputationExpression - // Types get colored as types when they occur in syntactic types or custom attributes - // Type variables get colored as types when they occur in syntactic types custom builders, custom operations get colored as keywords - | Item.Types (_, [OptionalArgumentAttribute]), LegitTypeOccurence, _, _, _, _ -> - () - - | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isInterfaceTy g) -> - add m SemanticClassificationType.Interface - - | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isStructTy g) -> - add m SemanticClassificationType.ValueType - - | Item.Types(_, TType_app(tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, _, _, _, m when isStructTyconRef tyconRef -> - add m SemanticClassificationType.ValueType - - | Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists isDisposableTy -> - add m SemanticClassificationType.DisposableType - - | Item.Types _, LegitTypeOccurence, _, _, _, m -> - add m SemanticClassificationType.ReferenceType + | Item.Types (_, ty :: _), LegitTypeOccurence, _, _, _, m -> + let reprToClassificationType repr tcref = + match repr with + | TFSharpObjectRepr om -> + match om.fsobjmodel_kind with + | TTyconClass -> SemanticClassificationType.ReferenceType + | TTyconInterface -> SemanticClassificationType.Interface + | TTyconStruct -> SemanticClassificationType.ValueType + | TTyconDelegate _ -> SemanticClassificationType.Delegate + | TTyconEnum _ -> SemanticClassificationType.Enumeration + | TRecdRepr _ + | TUnionRepr _ -> + if isStructTyconRef tcref then + SemanticClassificationType.ValueType + else + SemanticClassificationType.Type + | TILObjectRepr (TILObjectReprData (_, _, td)) -> + if td.IsClass then + SemanticClassificationType.ReferenceType + elif td.IsStruct then + SemanticClassificationType.ValueType + elif td.IsInterface then + SemanticClassificationType.Interface + elif td.IsEnum then + SemanticClassificationType.Enumeration + else + SemanticClassificationType.Delegate + | TAsmRepr _ -> SemanticClassificationType.TypeDef + | TMeasureableRepr _-> SemanticClassificationType.TypeDef +#if !NO_EXTENSIONTYPING + | TProvidedTypeExtensionPoint _-> SemanticClassificationType.TypeDef + | TProvidedNamespaceExtensionPoint _-> SemanticClassificationType.TypeDef +#endif + | TNoRepr -> SemanticClassificationType.ReferenceType + + let ty = stripTyEqns g ty + + if isMeasureTy g ty then + add m SemanticClassificationType.Measure + elif isDisposableTy ty then + add m SemanticClassificationType.DisposableType + else + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> + add m (reprToClassificationType tcref.TypeReprInfo tcref) + | ValueNone -> + if isStructTupleTy g ty then + add m SemanticClassificationType.ValueType + elif isRefTupleTy g ty then + add m SemanticClassificationType.ReferenceType + elif isFunction g ty then + add m SemanticClassificationType.Function + elif isTyparTy g ty then + add m SemanticClassificationType.ValueType + else + add m SemanticClassificationType.TypeDef | (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m -> add m SemanticClassificationType.TypeArgument | Item.ExnCase _, LegitTypeOccurence, _, _, _, m -> - add m SemanticClassificationType.ExceptionCase + add m SemanticClassificationType.Exception | Item.ModuleOrNamespaces (modref :: _), LegitTypeOccurence, _, _, _, m -> if modref.IsNamespace then @@ -243,11 +281,14 @@ module TcResolutionsExtensions = | Item.Event _, _, _, _, _, m -> add m SemanticClassificationType.Event + | (Item.ArgName _ | Item.SetterArg _), _, _, _, _, m -> + add m SemanticClassificationType.NamedArgument + | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then add m SemanticClassificationType.Enumeration elif tcref.IsExceptionDecl then - add m SemanticClassificationType.ExceptionCase // Todo, differentiate? + add m SemanticClassificationType.Exception elif tcref.IsFSharpDelegateTycon then add m SemanticClassificationType.Delegate elif tcref.IsFSharpInterfaceTycon then @@ -258,8 +299,11 @@ module TcResolutionsExtensions = add m SemanticClassificationType.Module elif tcref.IsNamespace then add m SemanticClassificationType.NameSpace - elif tcref.IsUnionTycon then - add m SemanticClassificationType.UnionCase // Todo, differentiate? + elif tcref.IsUnionTycon || tcref.IsRecordTycon then + if isStructTyconRef tcref then + add m SemanticClassificationType.ValueType + else + add m SemanticClassificationType.UnionCase elif tcref.IsILTycon then let (TILObjectReprData (_, _, tydef)) = tcref.ILTyconInfo diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 313f3c97e0e..709c66648d2 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -37,17 +37,20 @@ type SemanticClassificationType = | RecordField | MutableRecordField | RecordFieldAsFunction - | ExceptionCase + | Exception | Field | Event | Delegate + | NamedArgument + | Value + | Type + | TypeDef + | Measure /// Extension methods for the TcResolutions type. [] module internal TcResolutionsExtensions = - val (|CNR|) : cnr: CapturedNameResolution -> (Item * ItemOccurence * DisplayEnv * NameResolutionEnv * AccessorDomain * range) type TcResolutions with - member GetSemanticClassification: g: TcGlobals * amap: ImportMap * formatSpecifierLocations: (range * int) [] * range: range option -> struct(range * SemanticClassificationType) [] \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 250695c7069..61d76fe26c0 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -27,16 +27,18 @@ module internal FSharpClassificationTypes = let [] Disposable = "FSharp.Disposable" let getClassificationTypeName = function - | SemanticClassificationType.Function -> Function | SemanticClassificationType.MutableRecordField | SemanticClassificationType.MutableVar -> MutableVar | SemanticClassificationType.Printf -> Printf | SemanticClassificationType.DisposableValue | SemanticClassificationType.DisposableType -> Disposable | SemanticClassificationType.NameSpace -> ClassificationTypeNames.NamespaceName - | SemanticClassificationType.ExceptionCase + | SemanticClassificationType.Exception | SemanticClassificationType.Module + | SemanticClassificationType.Type + | SemanticClassificationType.TypeDef | SemanticClassificationType.ReferenceType -> ClassificationTypeNames.ClassName + | SemanticClassificationType.Measure | SemanticClassificationType.ValueType -> ClassificationTypeNames.StructName | SemanticClassificationType.ComputationExpression | SemanticClassificationType.IntrinsicFunction -> ClassificationTypeNames.Keyword @@ -44,18 +46,21 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Enumeration -> ClassificationTypeNames.EnumName | SemanticClassificationType.Field | SemanticClassificationType.UnionCaseField -> ClassificationTypeNames.FieldName - | SemanticClassificationType.Property -> ClassificationTypeNames.PropertyName | SemanticClassificationType.Interface -> ClassificationTypeNames.InterfaceName | SemanticClassificationType.TypeArgument -> ClassificationTypeNames.TypeParameterName | SemanticClassificationType.Operator -> ClassificationTypeNames.Operator | SemanticClassificationType.Constructor + | SemanticClassificationType.Function | SemanticClassificationType.Method -> ClassificationTypeNames.MethodName | SemanticClassificationType.ExtensionMethod -> ClassificationTypeNames.ExtensionMethodName | SemanticClassificationType.Literal -> ClassificationTypeNames.ConstantName + | SemanticClassificationType.Property | SemanticClassificationType.RecordFieldAsFunction | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName | SemanticClassificationType.Event -> ClassificationTypeNames.EventName | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName + | SemanticClassificationType.NamedArgument -> ClassificationTypeNames.LabelName + | SemanticClassificationType.Value -> ClassificationTypeNames.Identifier module internal ClassificationDefinitions = @@ -80,7 +85,6 @@ module internal ClassificationDefinitions = let colorData = // name, (light, dark) [ - FSharpClassificationTypes.Function, (Colors.Black, Color.FromRgb(220uy, 220uy, 220uy)) FSharpClassificationTypes.MutableVar, (Color.FromRgb(160uy, 128uy, 0uy), Color.FromRgb(255uy, 210uy, 28uy)) FSharpClassificationTypes.Printf, (Color.FromRgb(43uy, 145uy, 175uy), Color.FromRgb(78uy, 220uy, 176uy)) FSharpClassificationTypes.Disposable, (Colors.Tomato, Colors.Tomato) @@ -101,17 +105,10 @@ module internal ClassificationDefinitions = let ict = classificationTypeRegistry.GetClassificationType(ctype) let oldProps = formatMap.GetTextProperties(ict) let newProps = - let props = - match getCurrentThemeId() with - | LightTheme -> oldProps.SetForeground light - | DarkTheme -> oldProps.SetForeground dark - | UnknownTheme -> oldProps - - // Distinguish F# functions from values with bold - if ctype = FSharpClassificationTypes.Function then - props.SetBold(true) - else - props + match getCurrentThemeId() with + | LightTheme -> oldProps.SetForeground light + | DarkTheme -> oldProps.SetForeground dark + | UnknownTheme -> oldProps formatMap.SetTextProperties(ict, newProps) fontAndColorStorage.CloseCategory() |> ignore finally formatMap.EndBatchUpdate() From f5600d7691d58f606717fbac3c287b8b0ac7f194 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 12:17:48 -0700 Subject: [PATCH 04/16] Proper measure classification and tests --- src/fsharp/service/SemanticClassification.fs | 17 ++--- src/fsharp/service/SemanticClassification.fsi | 1 - .../ClassificationDefinitions.fs | 1 - .../src/FSharp.Editor/Common/RoslynHelpers.fs | 66 +++++++++---------- .../SemanticColorizationServiceTests.fs | 15 +++-- 5 files changed, 47 insertions(+), 53 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index bc103affabd..3c1c7d7c7c6 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -53,7 +53,6 @@ type SemanticClassificationType = | Value | Type | TypeDef - | Measure [] module TcResolutionsExtensions = @@ -71,11 +70,6 @@ module TcResolutionsExtensions = | ItemOccurence.Pattern _ -> Some() | _ -> None - let (|OptionalArgumentAttribute|_|) ttype = - match ttype with - | TType.TType_app(tref, _) when tref.Stamp = g.attrib_OptionalArgumentAttribute.TyconRef.Stamp -> Some() - | _ -> None - let (|KeywordIntrinsicValue|_|) (vref: ValRef) = if valRefEq g g.raise_vref vref || valRefEq g g.reraise_vref vref || @@ -200,6 +194,10 @@ module TcResolutionsExtensions = | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m -> add m SemanticClassificationType.ComputationExpression + // Special case measures for struct types + | Item.Types(_, TType_app(tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, _, _, _, m when isStructTyconRef tyconRef -> + add m SemanticClassificationType.ValueType + | Item.Types (_, ty :: _), LegitTypeOccurence, _, _, _, m -> let reprToClassificationType repr tcref = match repr with @@ -233,13 +231,10 @@ module TcResolutionsExtensions = | TProvidedTypeExtensionPoint _-> SemanticClassificationType.TypeDef | TProvidedNamespaceExtensionPoint _-> SemanticClassificationType.TypeDef #endif - | TNoRepr -> SemanticClassificationType.ReferenceType + | TNoRepr -> SemanticClassificationType.ReferenceType let ty = stripTyEqns g ty - - if isMeasureTy g ty then - add m SemanticClassificationType.Measure - elif isDisposableTy ty then + if isDisposableTy ty then add m SemanticClassificationType.DisposableType else match tryTcrefOfAppTy g ty with diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 709c66648d2..71f9a6be555 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -45,7 +45,6 @@ type SemanticClassificationType = | Value | Type | TypeDef - | Measure /// Extension methods for the TcResolutions type. [] diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 61d76fe26c0..f05c2175c09 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -38,7 +38,6 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Type | SemanticClassificationType.TypeDef | SemanticClassificationType.ReferenceType -> ClassificationTypeNames.ClassName - | SemanticClassificationType.Measure | SemanticClassificationType.ValueType -> ClassificationTypeNames.StructName | SemanticClassificationType.ComputationExpression | SemanticClassificationType.IntrinsicFunction -> ClassificationTypeNames.Keyword diff --git a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs index 83b79f198c3..2907352b757 100644 --- a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs @@ -51,39 +51,39 @@ module internal RoslynHelpers = /// maps from `LayoutTag` of the F# Compiler to Roslyn `TextTags` for use in tooltips let roslynTag = function - | LayoutTag.ActivePatternCase - | LayoutTag.ActivePatternResult - | LayoutTag.UnionCase - | LayoutTag.Enum -> TextTags.Enum - | LayoutTag.Alias - | LayoutTag.Class - | LayoutTag.Union - | LayoutTag.Record - | LayoutTag.UnknownType -> TextTags.Class - | LayoutTag.Delegate -> TextTags.Delegate - | LayoutTag.Event -> TextTags.Event - | LayoutTag.Field -> TextTags.Field - | LayoutTag.Interface -> TextTags.Interface - | LayoutTag.Struct -> TextTags.Struct - | LayoutTag.Keyword -> TextTags.Keyword - | LayoutTag.Local -> TextTags.Local - | LayoutTag.Member - | LayoutTag.ModuleBinding - | LayoutTag.RecordField - | LayoutTag.Property -> TextTags.Property - | LayoutTag.Method -> TextTags.Method - | LayoutTag.Namespace -> TextTags.Namespace - | LayoutTag.Module -> TextTags.Module - | LayoutTag.LineBreak -> TextTags.LineBreak - | LayoutTag.Space -> TextTags.Space - | LayoutTag.NumericLiteral -> TextTags.NumericLiteral - | LayoutTag.Operator -> TextTags.Operator - | LayoutTag.Parameter -> TextTags.Parameter - | LayoutTag.TypeParameter -> TextTags.TypeParameter - | LayoutTag.Punctuation -> TextTags.Punctuation - | LayoutTag.StringLiteral -> TextTags.StringLiteral - | LayoutTag.Text - | LayoutTag.UnknownEntity -> TextTags.Text + | LayoutTag.ActivePatternCase + | LayoutTag.ActivePatternResult + | LayoutTag.UnionCase + | LayoutTag.Enum -> TextTags.Enum + | LayoutTag.Alias + | LayoutTag.Class + | LayoutTag.Union + | LayoutTag.Record + | LayoutTag.UnknownType -> TextTags.Class + | LayoutTag.Delegate -> TextTags.Delegate + | LayoutTag.Event -> TextTags.Event + | LayoutTag.Field -> TextTags.Field + | LayoutTag.Interface -> TextTags.Interface + | LayoutTag.Struct -> TextTags.Struct + | LayoutTag.Keyword -> TextTags.Keyword + | LayoutTag.Local -> TextTags.Local + | LayoutTag.Member + | LayoutTag.ModuleBinding + | LayoutTag.RecordField + | LayoutTag.Property -> TextTags.Property + | LayoutTag.Method -> TextTags.Method + | LayoutTag.Namespace -> TextTags.Namespace + | LayoutTag.Module -> TextTags.Module + | LayoutTag.LineBreak -> TextTags.LineBreak + | LayoutTag.Space -> TextTags.Space + | LayoutTag.NumericLiteral -> TextTags.NumericLiteral + | LayoutTag.Operator -> TextTags.Operator + | LayoutTag.Parameter -> TextTags.Parameter + | LayoutTag.TypeParameter -> TextTags.TypeParameter + | LayoutTag.Punctuation -> TextTags.Punctuation + | LayoutTag.StringLiteral -> TextTags.StringLiteral + | LayoutTag.Text + | LayoutTag.UnknownEntity -> TextTags.Text let CollectTaggedText (list: List<_>) (t:TaggedText) = list.Add(TaggedText(roslynTag t.Tag, t.Text)) diff --git a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs index 46c2f265680..00f5940bf57 100644 --- a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs @@ -7,6 +7,7 @@ open Microsoft.VisualStudio.FSharp.Editor open FSharp.Compiler.SourceCodeServices open FSharp.Compiler open Microsoft.CodeAnalysis.Text +open Microsoft.CodeAnalysis.Classification [] type SemanticClassificationServiceTests() = @@ -57,13 +58,13 @@ type SemanticClassificationServiceTests() = let anyData = ranges |> List.exists (fun struct (range, sct) -> Range.rangeContainsPos range markerPos && ((FSharpClassificationTypes.getClassificationTypeName sct) = classificationType)) Assert.False(anyData, "Classification data was found when it wasn't expected.") - [] - [] - [] - [] - [] - [] - [] + [] // Fails + [] + [] // Fails + [] + [] // Fails + [] // Fails + [] member __.Measured_Types(marker: string, classificationType: string) = verifyClassificationAtEndOfMarker( """#light (*Light*) From 682e5b6c6f16cb60c5129fdc08907b8fa60e7c1b Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 12:23:04 -0700 Subject: [PATCH 05/16] remove ze comments --- .../tests/UnitTests/SemanticColorizationServiceTests.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs index 00f5940bf57..e1591ed0cb1 100644 --- a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs @@ -58,12 +58,12 @@ type SemanticClassificationServiceTests() = let anyData = ranges |> List.exists (fun struct (range, sct) -> Range.rangeContainsPos range markerPos && ((FSharpClassificationTypes.getClassificationTypeName sct) = classificationType)) Assert.False(anyData, "Classification data was found when it wasn't expected.") - [] // Fails + [] [] - [] // Fails + [] [] - [] // Fails - [] // Fails + [] + [] [] member __.Measured_Types(marker: string, classificationType: string) = verifyClassificationAtEndOfMarker( From dc0507dfcca3b00d8ea3c6f0b16498b0feab4719 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 14:46:42 -0700 Subject: [PATCH 06/16] Add clarifying comment --- .../FSharp.Editor/Classification/ClassificationDefinitions.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index f05c2175c09..9eead65504a 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -55,7 +55,7 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Literal -> ClassificationTypeNames.ConstantName | SemanticClassificationType.Property | SemanticClassificationType.RecordFieldAsFunction - | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName + | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName // Picking something with a distinct color instead of the white color that Property gives | SemanticClassificationType.Event -> ClassificationTypeNames.EventName | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName | SemanticClassificationType.NamedArgument -> ClassificationTypeNames.LabelName From f2dfd9a0f70afcd3903d768b7908ae9ebe2092c5 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 16:26:07 -0700 Subject: [PATCH 07/16] Distinguish property setter args from named argument labels --- src/fsharp/service/SemanticClassification.fs | 15 ++++++++++----- .../Classification/ClassificationDefinitions.fs | 2 +- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 3c1c7d7c7c6..4fce182087a 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -151,10 +151,11 @@ module TcResolutionsExtensions = add m SemanticClassificationType.Function | (Item.Value vref), _, _, _, _, m when isValRefDisposable vref -> - add m SemanticClassificationType.DisposableValue - | Item.Value _, _, _, _, _, m -> - add m SemanticClassificationType.Value + if isValRefDisposable vref then + add m SemanticClassificationType.DisposableValue + else + add m SemanticClassificationType.Value | Item.RecdField rfinfo, _, _, _, _, m -> match rfinfo with @@ -179,8 +180,9 @@ module TcResolutionsExtensions = else add m SemanticClassificationType.RecordField - | Item.Property _, _, _, _, _, m -> - add m SemanticClassificationType.Property + | Item.Property (_, pinfo :: _), _, _, _, _, m -> + if not pinfo.IsIndexer then + add m SemanticClassificationType.Property | (Item.CtorGroup _ | Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m -> add m SemanticClassificationType.Constructor @@ -279,6 +281,9 @@ module TcResolutionsExtensions = | (Item.ArgName _ | Item.SetterArg _), _, _, _, _, m -> add m SemanticClassificationType.NamedArgument + | Item.SetterArg _, _, _, _, _, m -> + add m SemanticClassificationType.Property + | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then add m SemanticClassificationType.Enumeration diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 9eead65504a..b50cda19599 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -56,9 +56,9 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Property | SemanticClassificationType.RecordFieldAsFunction | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName // Picking something with a distinct color instead of the white color that Property gives + | SemanticClassificationType.NamedArgument -> ClassificationTypeNames.LabelName | SemanticClassificationType.Event -> ClassificationTypeNames.EventName | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName - | SemanticClassificationType.NamedArgument -> ClassificationTypeNames.LabelName | SemanticClassificationType.Value -> ClassificationTypeNames.Identifier module internal ClassificationDefinitions = From f326ceec10c6950895480cf1e7fac0bbb9ab2274 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 17:05:42 -0700 Subject: [PATCH 08/16] Color local values, don't color properties and property-like things that way --- src/fsharp/service/SemanticClassification.fs | 11 ++++++----- src/fsharp/service/SemanticClassification.fsi | 1 + .../Classification/ClassificationDefinitions.fs | 3 ++- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 4fce182087a..9b4df9e77a2 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -51,6 +51,7 @@ type SemanticClassificationType = | Delegate | NamedArgument | Value + | LocalValue | Type | TypeDef @@ -135,9 +136,6 @@ module TcResolutionsExtensions = | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, _, _, _, m -> add m SemanticClassificationType.IntrinsicFunction - | (Item.Value vref), _, _, _, _, m when Option.isSome vref.LiteralValue -> - add m SemanticClassificationType.Literal - | (Item.Value vref), _, _, _, _, m when isFunction g vref.Type -> if valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then () @@ -150,10 +148,13 @@ module TcResolutionsExtensions = else add m SemanticClassificationType.Function - | (Item.Value vref), _, _, _, _, m when isValRefDisposable vref -> - + | (Item.Value vref), _, _, _, _, m -> if isValRefDisposable vref then add m SemanticClassificationType.DisposableValue + elif Option.isSome vref.LiteralValue then + add m SemanticClassificationType.Literal + elif vref.IsLocalRef && not vref.IsCompiledAsTopLevel then + add m SemanticClassificationType.LocalValue else add m SemanticClassificationType.Value diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 71f9a6be555..704a9d75d21 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -43,6 +43,7 @@ type SemanticClassificationType = | Delegate | NamedArgument | Value + | LocalValue | Type | TypeDef diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index b50cda19599..c4e42917d43 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -55,11 +55,12 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Literal -> ClassificationTypeNames.ConstantName | SemanticClassificationType.Property | SemanticClassificationType.RecordFieldAsFunction - | SemanticClassificationType.RecordField -> ClassificationTypeNames.LocalName // Picking something with a distinct color instead of the white color that Property gives + | SemanticClassificationType.RecordField -> ClassificationTypeNames.PropertyName // TODO - maybe pick something that isn't white by default like Property? | SemanticClassificationType.NamedArgument -> ClassificationTypeNames.LabelName | SemanticClassificationType.Event -> ClassificationTypeNames.EventName | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName | SemanticClassificationType.Value -> ClassificationTypeNames.Identifier + | SemanticClassificationType.LocalValue -> ClassificationTypeNames.LocalName module internal ClassificationDefinitions = From eab3c6f9391aac340a3fd3cacf02ec26dc36fee7 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 17:12:36 -0700 Subject: [PATCH 09/16] Dont't do the dumb --- src/fsharp/service/SemanticClassification.fs | 3 ++- src/fsharp/service/SemanticClassification.fsi | 1 + .../FSharp.Editor/Classification/ClassificationDefinitions.fs | 1 + 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 9b4df9e77a2..97b863c7796 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -52,6 +52,7 @@ type SemanticClassificationType = | NamedArgument | Value | LocalValue + | Parameter | Type | TypeDef @@ -153,7 +154,7 @@ module TcResolutionsExtensions = add m SemanticClassificationType.DisposableValue elif Option.isSome vref.LiteralValue then add m SemanticClassificationType.Literal - elif vref.IsLocalRef && not vref.IsCompiledAsTopLevel then + elif not vref.IsCompiledAsTopLevel then add m SemanticClassificationType.LocalValue else add m SemanticClassificationType.Value diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 704a9d75d21..4a9b0e2f313 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -44,6 +44,7 @@ type SemanticClassificationType = | NamedArgument | Value | LocalValue + | Parameter | Type | TypeDef diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index c4e42917d43..3b2544b6f47 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -61,6 +61,7 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName | SemanticClassificationType.Value -> ClassificationTypeNames.Identifier | SemanticClassificationType.LocalValue -> ClassificationTypeNames.LocalName + | SemanticClassificationType.Parameter -> ClassificationTypeNames.ParameterName module internal ClassificationDefinitions = From 2a09305f89288eb08babeb444c6b34acc3d7a862 Mon Sep 17 00:00:00 2001 From: cartermp Date: Fri, 19 Jun 2020 17:21:58 -0700 Subject: [PATCH 10/16] We can't distinguish between params and locals right now --- src/fsharp/service/SemanticClassification.fs | 1 - src/fsharp/service/SemanticClassification.fsi | 1 - .../FSharp.Editor/Classification/ClassificationDefinitions.fs | 1 - 3 files changed, 3 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 97b863c7796..eb4e1129142 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -52,7 +52,6 @@ type SemanticClassificationType = | NamedArgument | Value | LocalValue - | Parameter | Type | TypeDef diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 4a9b0e2f313..704a9d75d21 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -44,7 +44,6 @@ type SemanticClassificationType = | NamedArgument | Value | LocalValue - | Parameter | Type | TypeDef diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 3b2544b6f47..c4e42917d43 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -61,7 +61,6 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Delegate -> ClassificationTypeNames.DelegateName | SemanticClassificationType.Value -> ClassificationTypeNames.Identifier | SemanticClassificationType.LocalValue -> ClassificationTypeNames.LocalName - | SemanticClassificationType.Parameter -> ClassificationTypeNames.ParameterName module internal ClassificationDefinitions = From 890767d59994ce998b07fcafe1f91e47827c1ead Mon Sep 17 00:00:00 2001 From: cartermp Date: Sun, 21 Jun 2020 15:12:13 -0700 Subject: [PATCH 11/16] Updates per feedback from myself --- src/fsharp/service/SemanticClassification.fs | 24 ++++++++++++++----- src/fsharp/service/SemanticClassification.fsi | 3 ++- .../ClassificationDefinitions.fs | 3 ++- 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index eb4e1129142..3b04a6eb9bd 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -40,7 +40,8 @@ type SemanticClassificationType = | DisposableValue | Method | ExtensionMethod - | Constructor + | ConstructorForReferenceType + | ConstructorForValueType | Literal | RecordField | MutableRecordField @@ -97,10 +98,13 @@ module TcResolutionsExtensions = sResolutions.CapturedNameResolutions :> seq<_> let isDisposableTy (ty: TType) = + not (typeEquiv g ty g.system_IDisposable_ty) && protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) + + let isDiscardText (str: string) = str |> String.forall (fun c -> c = '_') let isValRefDisposable (vref: ValRef) = - not (vref.DisplayName = "_") && not (vref.DisplayName = "__") && isDisposableTy vref.Type + not (isDiscardText vref.DisplayName) && isDisposableTy vref.Type let isStructTyconRef (tyconRef: TyconRef) = let ty = generalizedTyconRef tyconRef @@ -153,7 +157,7 @@ module TcResolutionsExtensions = add m SemanticClassificationType.DisposableValue elif Option.isSome vref.LiteralValue then add m SemanticClassificationType.Literal - elif not vref.IsCompiledAsTopLevel then + elif not vref.IsCompiledAsTopLevel && not(isDiscardText vref.DisplayName) then add m SemanticClassificationType.LocalValue else add m SemanticClassificationType.Value @@ -184,9 +188,17 @@ module TcResolutionsExtensions = | Item.Property (_, pinfo :: _), _, _, _, _, m -> if not pinfo.IsIndexer then add m SemanticClassificationType.Property - - | (Item.CtorGroup _ | Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m -> - add m SemanticClassificationType.Constructor + + | Item.CtorGroup (_, minfos), _, _, _, _, m -> + if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then + add m SemanticClassificationType.DisposableType + elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then + add m SemanticClassificationType.ConstructorForValueType + else + add m SemanticClassificationType.ConstructorForReferenceType + + | (Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m -> + add m SemanticClassificationType.ConstructorForReferenceType | Item.MethodGroup (_, minfos, _), _, _, _, _, m -> if minfos |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 704a9d75d21..f2447219bd6 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -32,7 +32,8 @@ type SemanticClassificationType = | DisposableValue | Method | ExtensionMethod - | Constructor + | ConstructorForReferenceType + | ConstructorForValueType | Literal | RecordField | MutableRecordField diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index c4e42917d43..9f0a8bb203e 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -37,7 +37,9 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Module | SemanticClassificationType.Type | SemanticClassificationType.TypeDef + | SemanticClassificationType.ConstructorForReferenceType | SemanticClassificationType.ReferenceType -> ClassificationTypeNames.ClassName + | SemanticClassificationType.ConstructorForValueType | SemanticClassificationType.ValueType -> ClassificationTypeNames.StructName | SemanticClassificationType.ComputationExpression | SemanticClassificationType.IntrinsicFunction -> ClassificationTypeNames.Keyword @@ -48,7 +50,6 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Interface -> ClassificationTypeNames.InterfaceName | SemanticClassificationType.TypeArgument -> ClassificationTypeNames.TypeParameterName | SemanticClassificationType.Operator -> ClassificationTypeNames.Operator - | SemanticClassificationType.Constructor | SemanticClassificationType.Function | SemanticClassificationType.Method -> ClassificationTypeNames.MethodName | SemanticClassificationType.ExtensionMethod -> ClassificationTypeNames.ExtensionMethodName From 540fe2ebb2ef1616bc512a45e767c9c8d5a609c3 Mon Sep 17 00:00:00 2001 From: cartermp Date: Mon, 22 Jun 2020 10:22:40 -0700 Subject: [PATCH 12/16] do discards right --- src/fsharp/service/SemanticClassification.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 3b04a6eb9bd..301a1c1157a 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -101,10 +101,10 @@ module TcResolutionsExtensions = not (typeEquiv g ty g.system_IDisposable_ty) && protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) - let isDiscardText (str: string) = str |> String.forall (fun c -> c = '_') + let isDiscard (str: string) = str.StartsWith("_") let isValRefDisposable (vref: ValRef) = - not (isDiscardText vref.DisplayName) && isDisposableTy vref.Type + not (isDiscard vref.DisplayName) && isDisposableTy vref.Type let isStructTyconRef (tyconRef: TyconRef) = let ty = generalizedTyconRef tyconRef @@ -157,7 +157,7 @@ module TcResolutionsExtensions = add m SemanticClassificationType.DisposableValue elif Option.isSome vref.LiteralValue then add m SemanticClassificationType.Literal - elif not vref.IsCompiledAsTopLevel && not(isDiscardText vref.DisplayName) then + elif not vref.IsCompiledAsTopLevel && not(isDiscard vref.DisplayName) then add m SemanticClassificationType.LocalValue else add m SemanticClassificationType.Value From 6a014df103948e5201e04b6b7ad5b8c3dccd449c Mon Sep 17 00:00:00 2001 From: cartermp Date: Mon, 22 Jun 2020 12:53:25 -0700 Subject: [PATCH 13/16] Accessible colors for disposables + some fixes --- src/fsharp/service/SemanticClassification.fs | 4 +++- .../Classification/ClassificationDefinitions.fs | 11 +++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 301a1c1157a..f715f26349f 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -104,7 +104,9 @@ module TcResolutionsExtensions = let isDiscard (str: string) = str.StartsWith("_") let isValRefDisposable (vref: ValRef) = - not (isDiscard vref.DisplayName) && isDisposableTy vref.Type + not (isDiscard vref.DisplayName) && + // For values, we actually do want to color things if they literally are IDisposables + protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) let isStructTyconRef (tyconRef: TyconRef) = let ty = generalizedTyconRef tyconRef diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 9f0a8bb203e..689db8578c7 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -29,7 +29,6 @@ module internal FSharpClassificationTypes = let getClassificationTypeName = function | SemanticClassificationType.MutableRecordField | SemanticClassificationType.MutableVar -> MutableVar - | SemanticClassificationType.Printf -> Printf | SemanticClassificationType.DisposableValue | SemanticClassificationType.DisposableType -> Disposable | SemanticClassificationType.NameSpace -> ClassificationTypeNames.NamespaceName @@ -38,6 +37,7 @@ module internal FSharpClassificationTypes = | SemanticClassificationType.Type | SemanticClassificationType.TypeDef | SemanticClassificationType.ConstructorForReferenceType + | SemanticClassificationType.Printf | SemanticClassificationType.ReferenceType -> ClassificationTypeNames.ClassName | SemanticClassificationType.ConstructorForValueType | SemanticClassificationType.ValueType -> ClassificationTypeNames.StructName @@ -84,11 +84,10 @@ module internal ClassificationDefinitions = let themeService = serviceProvider.GetService(typeof) :?> IVsColorThemeService themeService.CurrentTheme.ThemeId - let colorData = // name, (light, dark) + let customColorData = // name, (light, dark) [ FSharpClassificationTypes.MutableVar, (Color.FromRgb(160uy, 128uy, 0uy), Color.FromRgb(255uy, 210uy, 28uy)) - FSharpClassificationTypes.Printf, (Color.FromRgb(43uy, 145uy, 175uy), Color.FromRgb(78uy, 220uy, 176uy)) - FSharpClassificationTypes.Disposable, (Colors.Tomato, Colors.Tomato) + FSharpClassificationTypes.Disposable, (Colors.Green, Color.FromRgb(51uy, 251uy, 96uy)) ] let setColors _ = @@ -100,7 +99,7 @@ module internal ClassificationDefinitions = let formatMap = classificationformatMapService.GetClassificationFormatMap(category = "text") try formatMap.BeginBatchUpdate() - for ctype, (light, dark) in colorData do + for ctype, (light, dark) in customColorData do // we don't touch the changes made by the user if fontAndColorStorage.GetItem(ctype, Array.zeroCreate 1) <> VSConstants.S_OK then let ict = classificationTypeRegistry.GetClassificationType(ctype) @@ -119,7 +118,7 @@ module internal ClassificationDefinitions = interface IDisposable with member __.Dispose() = VSColorTheme.remove_ThemeChanged handler member __.GetColor(ctype) = - let light, dark = colorData |> Map.ofList |> Map.find ctype + let light, dark = customColorData |> Map.ofList |> Map.find ctype match getCurrentThemeId() with | LightTheme -> Nullable light | DarkTheme -> Nullable dark From a0fafc478c7cf1389a188b94e0b152f9a91fc71c Mon Sep 17 00:00:00 2001 From: cartermp Date: Mon, 22 Jun 2020 12:56:08 -0700 Subject: [PATCH 14/16] Remove exports for things we don't do anymore --- .../ClassificationDefinitions.fs | 29 ------------------- 1 file changed, 29 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 689db8578c7..6fc00b7f17f 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -21,9 +21,7 @@ open FSharp.Compiler.SourceCodeServices [] module internal FSharpClassificationTypes = - let [] Function = "FSharp.Function" let [] MutableVar = "FSharp.MutableVar" - let [] Printf = "FSharp.Printf" let [] Disposable = "FSharp.Disposable" let getClassificationTypeName = function @@ -126,29 +124,13 @@ module internal ClassificationDefinitions = interface ISetThemeColors with member this.SetColors() = setColors() - - [] - let FSharpFunctionClassificationType : ClassificationTypeDefinition = null - [] let FSharpMutableVarClassificationType : ClassificationTypeDefinition = null - [] - let FSharpPrintfClassificationType : ClassificationTypeDefinition = null [] let FSharpDisposableClassificationType : ClassificationTypeDefinition = null - [)>] - [] - [] - [] - [] - type internal FSharpFunctionTypeFormat() as self = - inherit ClassificationFormatDefinition() - - do self.DisplayName <- SR.FSharpFunctionsOrMethodsClassificationType() - [)>] [] [] @@ -160,17 +142,6 @@ module internal ClassificationDefinitions = do self.DisplayName <- SR.FSharpMutableVarsClassificationType() self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.MutableVar - [)>] - [] - [] - [] - [] - type internal FSharpPrintfTypeFormat [](theme: ThemeColors) as self = - inherit ClassificationFormatDefinition() - - do self.DisplayName <- SR.FSharpPrintfFormatClassificationType() - self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.Printf - [)>] [] [] From 9f55d3458029e82bf081c5a4dec2e932986aba3e Mon Sep 17 00:00:00 2001 From: cartermp Date: Mon, 22 Jun 2020 16:26:27 -0700 Subject: [PATCH 15/16] Softer green --- .../FSharp.Editor/Classification/ClassificationDefinitions.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 6fc00b7f17f..1dea67f4f35 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -85,7 +85,7 @@ module internal ClassificationDefinitions = let customColorData = // name, (light, dark) [ FSharpClassificationTypes.MutableVar, (Color.FromRgb(160uy, 128uy, 0uy), Color.FromRgb(255uy, 210uy, 28uy)) - FSharpClassificationTypes.Disposable, (Colors.Green, Color.FromRgb(51uy, 251uy, 96uy)) + FSharpClassificationTypes.Disposable, (Colors.Green, Color.FromRgb(2uy, 183uy, 43uy)) ] let setColors _ = From f79767c3d4982a46ef13ab44ff34a6ddd80fcdf9 Mon Sep 17 00:00:00 2001 From: cartermp Date: Tue, 23 Jun 2020 09:06:23 -0700 Subject: [PATCH 16/16] Reduce diff --- .../src/FSharp.Editor/Common/RoslynHelpers.fs | 66 +++++++++---------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs index 2907352b757..83b79f198c3 100644 --- a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs @@ -51,39 +51,39 @@ module internal RoslynHelpers = /// maps from `LayoutTag` of the F# Compiler to Roslyn `TextTags` for use in tooltips let roslynTag = function - | LayoutTag.ActivePatternCase - | LayoutTag.ActivePatternResult - | LayoutTag.UnionCase - | LayoutTag.Enum -> TextTags.Enum - | LayoutTag.Alias - | LayoutTag.Class - | LayoutTag.Union - | LayoutTag.Record - | LayoutTag.UnknownType -> TextTags.Class - | LayoutTag.Delegate -> TextTags.Delegate - | LayoutTag.Event -> TextTags.Event - | LayoutTag.Field -> TextTags.Field - | LayoutTag.Interface -> TextTags.Interface - | LayoutTag.Struct -> TextTags.Struct - | LayoutTag.Keyword -> TextTags.Keyword - | LayoutTag.Local -> TextTags.Local - | LayoutTag.Member - | LayoutTag.ModuleBinding - | LayoutTag.RecordField - | LayoutTag.Property -> TextTags.Property - | LayoutTag.Method -> TextTags.Method - | LayoutTag.Namespace -> TextTags.Namespace - | LayoutTag.Module -> TextTags.Module - | LayoutTag.LineBreak -> TextTags.LineBreak - | LayoutTag.Space -> TextTags.Space - | LayoutTag.NumericLiteral -> TextTags.NumericLiteral - | LayoutTag.Operator -> TextTags.Operator - | LayoutTag.Parameter -> TextTags.Parameter - | LayoutTag.TypeParameter -> TextTags.TypeParameter - | LayoutTag.Punctuation -> TextTags.Punctuation - | LayoutTag.StringLiteral -> TextTags.StringLiteral - | LayoutTag.Text - | LayoutTag.UnknownEntity -> TextTags.Text + | LayoutTag.ActivePatternCase + | LayoutTag.ActivePatternResult + | LayoutTag.UnionCase + | LayoutTag.Enum -> TextTags.Enum + | LayoutTag.Alias + | LayoutTag.Class + | LayoutTag.Union + | LayoutTag.Record + | LayoutTag.UnknownType -> TextTags.Class + | LayoutTag.Delegate -> TextTags.Delegate + | LayoutTag.Event -> TextTags.Event + | LayoutTag.Field -> TextTags.Field + | LayoutTag.Interface -> TextTags.Interface + | LayoutTag.Struct -> TextTags.Struct + | LayoutTag.Keyword -> TextTags.Keyword + | LayoutTag.Local -> TextTags.Local + | LayoutTag.Member + | LayoutTag.ModuleBinding + | LayoutTag.RecordField + | LayoutTag.Property -> TextTags.Property + | LayoutTag.Method -> TextTags.Method + | LayoutTag.Namespace -> TextTags.Namespace + | LayoutTag.Module -> TextTags.Module + | LayoutTag.LineBreak -> TextTags.LineBreak + | LayoutTag.Space -> TextTags.Space + | LayoutTag.NumericLiteral -> TextTags.NumericLiteral + | LayoutTag.Operator -> TextTags.Operator + | LayoutTag.Parameter -> TextTags.Parameter + | LayoutTag.TypeParameter -> TextTags.TypeParameter + | LayoutTag.Punctuation -> TextTags.Punctuation + | LayoutTag.StringLiteral -> TextTags.StringLiteral + | LayoutTag.Text + | LayoutTag.UnknownEntity -> TextTags.Text let CollectTaggedText (list: List<_>) (t:TaggedText) = list.Add(TaggedText(roslynTag t.Tag, t.Text))