diff --git a/Directory.Build.props b/Directory.Build.props deleted file mode 100644 index e9c2a5c5e99..00000000000 --- a/Directory.Build.props +++ /dev/null @@ -1,6 +0,0 @@ - - - - - - diff --git a/Directory.Build.targets b/Directory.Build.targets deleted file mode 100644 index 08da3ab0966..00000000000 --- a/Directory.Build.targets +++ /dev/null @@ -1,5 +0,0 @@ - - - - - diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props deleted file mode 100644 index 72afe7c03d7..00000000000 --- a/FSharpBuild.Directory.Build.props +++ /dev/null @@ -1,109 +0,0 @@ - - - - - - - true - - - - - $(RepoRoot)src - $(ArtifactsDir)\SymStore - $(ArtifactsDir)\Bootstrap - 4.4.0 - 1182;0025;$(WarningsAsErrors) - - - - - - $(RestoreAdditionalProjectSources);$(ArtifactsPackagesDir) - $(ArtifactsPackagesDir) - - - $(NUGET_PACKAGES) - $(UserProfile)\.nuget\packages\ - $(HOME)/.nuget/packages/ - - - $(NuGetPackageRoot)\ - $(NuGetPackageRoot)/ - - - true - - - - - /usr - /Library/Frameworks/Mono.framework/Versions/Current - $(MonoRoot)/lib/mono - true - $(MonoLibFolder)/4.5-api - $(MonoLibFolder)/4.5.1-api - $(MonoLibFolder)/4.5.2-api - $(MonoLibFolder)/4.6-api - $(MonoLibFolder)/4.6.1-api - $(MonoLibFolder)/4.6.2-api - $(MonoLibFolder)/4.7-api - $(MonoLibFolder)/4.7.1-api - $(MonoLibFolder)/4.7.2-api;$(MonoLibFolder)/4.7.2-api/Facades - - - - - Microsoft - - - $(FSharpSourcesRoot)\fsharp\test.snk - false - STRONG_NAME_FSHARP_COMPILER_WITH_TEST_KEY;$(DefineConstants) - - - - - false - true - - - - - false - false - https://github.com/Microsoft/visualfsharp - git - - - - <_DotGitDir>$(RepoRoot).git - <_HeadFileContent Condition="Exists('$(_DotGitDir)/HEAD')">$([System.IO.File]::ReadAllText('$(_DotGitDir)/HEAD').Trim()) - <_RefPath Condition="$(_HeadFileContent.StartsWith('ref: '))">$(_DotGitDir)/$(_HeadFileContent.Substring(5)) - $(BUILD_SOURCEVERSION) - $([System.IO.File]::ReadAllText('$(_RefPath)').Trim()) - - - - - $(NoWarn);FS2003 - true - embedded - fs - false - true - - - - $(DefineConstants);TESTING_ON_LINUX - - - - - $(ProtoOutputPath)\fsc\Microsoft.FSharp.Targets - $(ProtoOutputPath)\fsc\Microsoft.FSharp.NetSdk.props - $(ProtoOutputPath)\fsc\Microsoft.FSharp.NetSdk.targets - $(ProtoOutputPath)\fsc\Microsoft.FSharp.Overrides.NetSdk.targets - - - diff --git a/FSharpBuild.Directory.Build.targets b/FSharpBuild.Directory.Build.targets deleted file mode 100644 index 7548cef7acf..00000000000 --- a/FSharpBuild.Directory.Build.targets +++ /dev/null @@ -1,64 +0,0 @@ - - - - - - - - - - - <__TargetFilePath>@(NoneSubstituteText->'$(IntermediateOutputPath)%(Filename)%(Extension)') - <__TargetFileName>@(NoneSubstituteText->'%(Filename)%(Extension)') - - <_ReplacementText>$([System.IO.File]::ReadAllText('%(NoneSubstituteText.FullPath)')) - <_ReplacementText Condition="'%(NoneSubstituteText.Pattern1)' != ''">$(_ReplacementText.Replace('%(NoneSubstituteText.Pattern1)', '%(NoneSubstituteText.Replacement1)')) - <_ReplacementText Condition="'%(NoneSubstituteText.Pattern2)' != ''">$(_ReplacementText.Replace('%(NoneSubstituteText.Pattern2)', '%(NoneSubstituteText.Replacement2)')) - - <_CopyToOutputDirectory Condition="'%(NoneSubstituteText.CopyToOutputDirectory)' != ''">%(NoneSubstituteText.CopyToOutputDirectory) - <_CopyToOutputDirectory Condition="'%(NoneSubstituteText.CopyToOutputDirectory)' == ''">Never - - - - - - - - - - - - - - - - <_BuildPropertyLines Remove="@(_BuildPropertyLines)" /> - <_BuildPropertyLines Include="// <auto-generated >" /> - <_BuildPropertyLines Include="// <Generated by the FSharp WriteCodeFragment class./>" /> - <_BuildPropertyLines Include="// </auto-generated/>" /> - <_BuildPropertyLines Include="//" /> - <_BuildPropertyLines Include="module internal FSharp.BuildProperties" /> - <_BuildPropertyLines Include="let fsProductVersion = "$(FSPRODUCTVERSION)"" /> - <_BuildPropertyLines Include="let fsLanguageVersion = "$(FSLANGUAGEVERSION)"" /> - - - - - - - - - - - - - diff --git a/eng/Versions.props b/eng/Versions.props index 6f8ef30d19b..948f10cf498 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -4,10 +4,10 @@ false true - true - true - true - true + + + + diff --git a/src/buildtools/fslex/fslex.fsproj b/src/buildtools/fslex/fslex.fsproj index e348901415c..349d981c4a1 100644 --- a/src/buildtools/fslex/fslex.fsproj +++ b/src/buildtools/fslex/fslex.fsproj @@ -2,7 +2,7 @@ Exe - net472;netcoreapp2.1 + net472 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstant) true diff --git a/src/buildtools/fsyacc/fsyacc.fsproj b/src/buildtools/fsyacc/fsyacc.fsproj index e21a730c617..a52a70c96da 100644 --- a/src/buildtools/fsyacc/fsyacc.fsproj +++ b/src/buildtools/fsyacc/fsyacc.fsproj @@ -2,7 +2,7 @@ Exe - net472;netcoreapp2.1 + net472 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstant) true diff --git a/vsintegration/Directory.Build.props b/vsintegration/Directory.Build.props deleted file mode 100644 index eebd6774fae..00000000000 --- a/vsintegration/Directory.Build.props +++ /dev/null @@ -1,12 +0,0 @@ - - - - net472 - v4.7.2 - true - true - - - - - diff --git a/vsintegration/Directory.Build.targets b/vsintegration/Directory.Build.targets deleted file mode 100644 index bc5c6d7195c..00000000000 --- a/vsintegration/Directory.Build.targets +++ /dev/null @@ -1,23 +0,0 @@ - - - - - - true - - - - - - - - - - - - - - - - - diff --git a/vsintegration/src/Directory.Build.props b/vsintegration/src/Directory.Build.props deleted file mode 100644 index f7a21adf80c..00000000000 --- a/vsintegration/src/Directory.Build.props +++ /dev/null @@ -1,12 +0,0 @@ - - - - - - false - false - true - false - - - diff --git a/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs b/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs index dd3be821094..ac2308226c7 100644 --- a/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs +++ b/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs @@ -12,7 +12,6 @@ open Microsoft.VisualStudio.Text.BraceCompletion open Microsoft.VisualStudio.Text.Operations open Microsoft.VisualStudio.Text open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.Utilities open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Text open Microsoft.CodeAnalysis.Host @@ -504,7 +503,7 @@ type EditorBraceCompletionSessionFactory() = null [)>] -[] +[] [] [] [] diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinition.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinition.fs new file mode 100644 index 00000000000..f373586fc87 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinition.fs @@ -0,0 +1,26 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor + +open Microsoft.VisualStudio.Text.Classification +open System.ComponentModel.Composition +open System +open System.Windows.Media +open Microsoft.VisualStudio.Language.StandardClassification + +module internal ClassificationDefinition = + [] + [] + [] + let FSharpMutableVarClassificationType : ClassificationTypeDefinition = null + +[)>] +[] +[] +[] +[] +type internal FSharpMutableVarTypeFormat() as self = + inherit EditorFormatDefinition() + + do self.DisplayName <- SR.FSharpMutableVarsClassificationType() + self.ForegroundColor <- Nullable(Color.FromRgb(255uy, 210uy, 28uy)) \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs deleted file mode 100644 index 749c3ceed7a..00000000000 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ /dev/null @@ -1,186 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open System -open System.ComponentModel.Composition -open System.Windows.Media - -open Microsoft.VisualStudio -open Microsoft.VisualStudio.Editor -open Microsoft.VisualStudio.PlatformUI -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop -open Microsoft.Internal.VisualStudio.Shell.Interop -open Microsoft.VisualStudio.Language.StandardClassification -open Microsoft.VisualStudio.Text.Classification -open Microsoft.VisualStudio.Utilities -open Microsoft.CodeAnalysis.Classification - -open FSharp.Compiler.SourceCodeServices - -[] -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 getClassificationTypeName = function - | SemanticClassificationType.ReferenceType -> ReferenceType - | SemanticClassificationType.Module -> Module - | SemanticClassificationType.ValueType -> ValueType - | SemanticClassificationType.Function -> Function - | SemanticClassificationType.MutableVar -> MutableVar - | SemanticClassificationType.Printf -> Printf - | SemanticClassificationType.ComputationExpression - | SemanticClassificationType.IntrinsicFunction -> Keyword - | SemanticClassificationType.UnionCase - | SemanticClassificationType.Enumeration -> Enum - | SemanticClassificationType.Property -> Property - | SemanticClassificationType.Interface -> Interface - | SemanticClassificationType.TypeArgument -> TypeArgument - | SemanticClassificationType.Operator -> Operator - | SemanticClassificationType.Disposable -> Disposable - -module internal ClassificationDefinitions = - - [] - [)>] - type internal ThemeColors - [] - ( - classificationformatMapService: IClassificationFormatMapService, - classificationTypeRegistry: IClassificationTypeRegistryService, - [)>] serviceProvider: IServiceProvider - ) = - - let (| LightTheme | DarkTheme | UnknownTheme |) id = - if id = KnownColorThemes.Light || id = KnownColorThemes.Blue || id = Guids.blueHighContrastThemeId then LightTheme - elif id = KnownColorThemes.Dark then DarkTheme - else UnknownTheme - - let getCurrentThemeId() = - 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 setColors _ = - let fontAndColorStorage = serviceProvider.GetService(typeof) :?> IVsFontAndColorStorage - let fontAndColorCacheManager = serviceProvider.GetService(typeof) :?> IVsFontAndColorCacheManager - fontAndColorCacheManager.CheckCache( ref DefGuidList.guidTextEditorFontCategory) |> ignore - fontAndColorStorage.OpenCategory(ref DefGuidList.guidTextEditorFontCategory, uint32 __FCSTORAGEFLAGS.FCSF_READONLY) |> ignore - - let formatMap = classificationformatMapService.GetClassificationFormatMap(category = "text") - try - formatMap.BeginBatchUpdate() - for ctype, (light, dark) in colorData 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) - let oldProps = formatMap.GetTextProperties(ict) - let newProps = match getCurrentThemeId() with - | LightTheme -> oldProps.SetForeground light - | DarkTheme -> oldProps.SetForeground dark - | UnknownTheme -> oldProps - formatMap.SetTextProperties(ict, newProps) - fontAndColorStorage.CloseCategory() |> ignore - finally formatMap.EndBatchUpdate() - - let handler = ThemeChangedEventHandler setColors - do VSColorTheme.add_ThemeChanged handler - interface IDisposable with member __.Dispose() = VSColorTheme.remove_ThemeChanged handler - - member __.GetColor(ctype) = - let light, dark = colorData |> Map.ofList |> Map.find ctype - match getCurrentThemeId() with - | LightTheme -> Nullable light - | DarkTheme -> Nullable dark - | UnknownTheme -> Nullable() - - interface ISetThemeColors with member this.SetColors() = setColors() - - - [] - let FSharpFunctionClassificationType : ClassificationTypeDefinition = null - - [] - let FSharpMutableVarClassificationType : ClassificationTypeDefinition = null - - [] - let FSharpPrintfClassificationType : ClassificationTypeDefinition = null - - [] - let FSharpPropertyClassificationType : ClassificationTypeDefinition = null - - [] - let FSharpDisposableClassificationType : ClassificationTypeDefinition = null - - [)>] - [] - [] - [] - [] - type internal FSharpFunctionTypeFormat() as self = - inherit ClassificationFormatDefinition() - - do self.DisplayName <- SR.FSharpFunctionsOrMethodsClassificationType() - - [)>] - [] - [] - [] - [] - type internal FSharpMutableVarTypeFormat [](theme: ThemeColors) as self = - inherit ClassificationFormatDefinition() - - 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 - - [)>] - [] - [] - [] - [] - type internal FSharpPropertyFormat() as self = - inherit ClassificationFormatDefinition() - - do self.DisplayName <- SR.FSharpPropertiesClassificationType() - - [)>] - [] - [] - [] - [] - type internal FSharpDisposableFormat [](theme: ThemeColors) as self = - inherit ClassificationFormatDefinition() - - do self.DisplayName <- SR.FSharpDisposablesClassificationType() - self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.Disposable \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index d950a0abbf5..2e858a8915e 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -14,7 +14,10 @@ open Microsoft.CodeAnalysis.Editor open Microsoft.CodeAnalysis.Host.Mef open Microsoft.CodeAnalysis.Text open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification - +open Microsoft.VisualStudio.Text.Classification +open System.Windows.Media +open MonoDevelop.Core +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor // IEditorClassificationService is marked as Obsolete, but is still supported. The replacement (IClassificationService) // is internal to Microsoft.CodeAnalysis.Workspaces which we don't have internals visible to. Rather than add yet another // IVT, we'll maintain the status quo. @@ -22,6 +25,43 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification open FSharp.Compiler.SourceCodeServices +[] +module internal FSharpClassificationTypes = + let [] Function = ClassificationTypeNames.MethodName + let [] MutableVar = "mutable name" + let [] Printf = ClassificationTypeNames.MethodName + let [] ReferenceType = ClassificationTypeNames.ClassName + let [] Module = ClassificationTypeNames.ClassName + let [] ValueType = ClassificationTypeNames.StructName + let [] Keyword = ClassificationTypeNames.Keyword + let [] Enum = ClassificationTypeNames.EnumName + let [] Property = ClassificationTypeNames.PropertyName + let [] Interface = ClassificationTypeNames.InterfaceName + let [] TypeArgument = ClassificationTypeNames.TypeParameterName + let [] Operator = ClassificationTypeNames.Operator + let [] Disposable = ClassificationTypeNames.ClassName + + let getClassificationTypeName = function + | SemanticClassificationType.ReferenceType -> ReferenceType + | SemanticClassificationType.Module -> Module + | SemanticClassificationType.ValueType -> ValueType + | SemanticClassificationType.Function -> Function + | SemanticClassificationType.MutableVar -> + if PropertyService.Get("FSharpBinding.HighlightMutables", false) then + MutableVar + else + ClassificationTypeNames.LocalName + | SemanticClassificationType.Printf -> Printf + | SemanticClassificationType.ComputationExpression + | SemanticClassificationType.IntrinsicFunction -> Keyword + | SemanticClassificationType.UnionCase + | SemanticClassificationType.Enumeration -> Enum + | SemanticClassificationType.Property -> Property + | SemanticClassificationType.Interface -> Interface + | SemanticClassificationType.TypeArgument -> TypeArgument + | SemanticClassificationType.Operator -> Operator + | SemanticClassificationType.Disposable -> Disposable + [)>] type internal FSharpClassificationService [] @@ -32,8 +72,9 @@ type internal FSharpClassificationService static let userOpName = "SemanticColorization" interface IFSharpClassificationService with - // Do not perform classification if we don't have project options (#defines matter) - member __.AddLexicalClassifications(_: SourceText, _: TextSpan, _: List, _: CancellationToken) = () + + member __.AddLexicalClassifications(sourceText: SourceText, textSpan: TextSpan, result: List, cancellationToken: CancellationToken) = + result.AddRange(Tokenizer.getClassifiedSpans(DocumentId.CreateNewId(ProjectId.CreateNewId()), sourceText, textSpan, Some("fake.fs"), [], cancellationToken)) member __.AddSyntacticClassificationsAsync(document: Document, textSpan: TextSpan, result: List, cancellationToken: CancellationToken) = async { @@ -53,9 +94,9 @@ type internal FSharpClassificationService let! _, _, checkResults = checkerProvider.Checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = false, userOpName=userOpName) // it's crucial to not return duplicated or overlapping `ClassifiedSpan`s because Find Usages service crashes. let targetRange = RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText) - let classificationData = checkResults.GetSemanticClassification (Some targetRange) |> Array.distinctBy fst + let classificationData = checkResults.GetSemanticClassification (Some targetRange) - for (range, classificationType) in classificationData do + for struct (range, classificationType) in classificationData do match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with | None -> () | Some span -> @@ -69,5 +110,3 @@ type internal FSharpClassificationService // Do not perform classification if we don't have project options (#defines matter) member __.AdjustStaleClassification(_: SourceText, classifiedSpan: ClassifiedSpan) : ClassifiedSpan = classifiedSpan - - diff --git a/vsintegration/src/FSharp.Editor/CodeFix/FixIndexerAccess.fs b/vsintegration/src/FSharp.Editor/CodeFix/FixIndexerAccess.fs index eb9a49c0fad..bc53e35fbd7 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/FixIndexerAccess.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/FixIndexerAccess.fs @@ -48,7 +48,8 @@ type internal FSharpFixIndexerAccessCodeFixProvider() = let codefix = CodeFixHelpers.createTextChangeCodeFix( - CompilerDiagnostics.getErrorMessage AddIndexerDot, + Microsoft.VisualStudio.UI.GettextCatalog.GetString "Add Indexer Dot", + //CompilerDiagnostics.getErrorMessage AddIndexerDot, context, (fun () -> asyncMaybe.Return [| TextChange(span, replacement.TrimEnd() + ".") |])) diff --git a/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs b/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs index 8b46a80b7d9..06ac261d7f2 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs @@ -6,7 +6,6 @@ open System.Composition open System.Threading.Tasks open Microsoft.CodeAnalysis.CodeFixes open Microsoft.CodeAnalysis.CodeActions -open FSharp.Compiler.SourceCodeServices [] type internal FSharpProposeUpperCaseLabelCodeFixProvider @@ -25,7 +24,7 @@ type internal FSharpProposeUpperCaseLabelCodeFixProvider asyncMaybe { let textChanger (originalText: string) = originalText.[0].ToString().ToUpper() + originalText.Substring(1) let! solutionChanger, originalText = SymbolHelpers.changeAllSymbolReferences(context.Document, context.Span, textChanger, projectInfoManager, checkerProvider.Checker, userOpName) - let title = CompilerDiagnostics.getErrorMessage (ReplaceWithSuggestion <| textChanger originalText) + let title = textChanger originalText context.RegisterCodeFix( CodeAction.Create(title, solutionChanger, title), context.Diagnostics |> Seq.filter (fun x -> fixableDiagnosticIds |> List.contains x.Id) |> Seq.toImmutableArray) diff --git a/vsintegration/src/FSharp.Editor/CodeFix/RenameParamToMatchSignature.fs b/vsintegration/src/FSharp.Editor/CodeFix/RenameParamToMatchSignature.fs index 245c1ff1405..c7fb2f2f5fc 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/RenameParamToMatchSignature.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/RenameParamToMatchSignature.fs @@ -54,7 +54,7 @@ type internal FSharpRenameParamToMatchSignature yield TextChange(textSpan, replacement) |] return changes } - let title = CompilerDiagnostics.getErrorMessage (ReplaceWithSuggestion suggestion) + let title = suggestion//CompilerDiagnostics.getErrorMessage (ReplaceWithSuggestion suggestion) let codefix = CodeFixHelpers.createTextChangeCodeFix(title, context, computeChanges) context.RegisterCodeFix(codefix, diagnostics) | _ -> () diff --git a/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs b/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs index 969cfb55a16..fafc461cbde 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs @@ -59,10 +59,11 @@ type internal FSharpReplaceWithSuggestionCodeFixProvider let replacement = Keywords.QuoteIdentifierIfNeeded suggestion let codeFix = CodeFixHelpers.createTextChangeCodeFix( - CompilerDiagnostics.getErrorMessage (ReplaceWithSuggestion suggestion), + suggestion, + //CompilerDiagnostics.getErrorMessage (ReplaceWithSuggestion suggestion), context, (fun () -> asyncMaybe.Return [| TextChange(context.Span, replacement) |])) - + context.RegisterCodeFix(codeFix, diagnostics) } |> Async.Ignore diff --git a/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs b/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs deleted file mode 100644 index eaf4b541a84..00000000000 --- a/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs +++ /dev/null @@ -1,103 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace rec Microsoft.VisualStudio.FSharp.Editor - -open System -open Microsoft.VisualStudio.Text -open Microsoft.VisualStudio.Text.Editor -open System.ComponentModel.Composition -open Microsoft.VisualStudio.Utilities -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio -open Microsoft.VisualStudio.LanguageServices -open Microsoft.VisualStudio.Text.Tagging -open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor.Shared.Utilities - -[)>] -[)>] -[)>] -[] -[] -type internal CodeLensProvider - [] - ( - [)>] serviceProvider: IServiceProvider, - textDocumentFactory: ITextDocumentFactoryService, - checkerProvider: FSharpCheckerProvider, - projectInfoManager: FSharpProjectOptionsManager, - typeMap : FSharpClassificationTypeMap Lazy, - settings: EditorOptions - ) = - - let lineLensProvider = ResizeArray() - let taggers = ResizeArray() - let componentModel = Package.GetGlobalService(typeof) :?> ComponentModelHost.IComponentModel - let workspace = componentModel.GetService() - - /// Returns an provider for the textView if already one has been created. Else create one. - let addCodeLensProviderOnce wpfView buffer = - let res = taggers |> Seq.tryFind(fun (view, _) -> view = wpfView) - match res with - | Some (_, (tagger, _)) -> tagger - | None -> - let documentId = - lazy ( - match textDocumentFactory.TryGetTextDocument(buffer) with - | true, textDocument -> - Seq.tryHead (workspace.CurrentSolution.GetDocumentIdsWithFilePath(textDocument.FilePath)) - | _ -> None - |> Option.get - ) - - let tagger = CodeLensGeneralTagger(wpfView, buffer) - let service = FSharpCodeLensService(serviceProvider, workspace, documentId, buffer, checkerProvider.Checker, projectInfoManager, componentModel.GetService(), typeMap, tagger, settings) - let provider = (wpfView, (tagger, service)) - wpfView.Closed.Add (fun _ -> taggers.Remove provider |> ignore) - taggers.Add((wpfView, (tagger, service))) - tagger - - /// Returns an provider for the textView if already one has been created. Else create one. - let addLineLensProviderOnce wpfView buffer = - let res = lineLensProvider |> Seq.tryFind(fun (view, _) -> view = wpfView) - match res with - | None -> - let documentId = - lazy ( - match textDocumentFactory.TryGetTextDocument(buffer) with - | true, textDocument -> - Seq.tryHead (workspace.CurrentSolution.GetDocumentIdsWithFilePath(textDocument.FilePath)) - | _ -> None - |> Option.get - ) - let service = FSharpCodeLensService(serviceProvider, workspace, documentId, buffer, checkerProvider.Checker, projectInfoManager, componentModel.GetService(), typeMap, LineLensDisplayService(wpfView, buffer), settings) - let provider = (wpfView, service) - wpfView.Closed.Add (fun _ -> lineLensProvider.Remove provider |> ignore) - lineLensProvider.Add(provider) - | _ -> () - - [); Name("CodeLens"); - Order(Before = PredefinedAdornmentLayers.Text); - TextViewRole(PredefinedTextViewRoles.Document)>] - member val CodeLensAdornmentLayerDefinition : AdornmentLayerDefinition = null with get, set - - [); Name("LineLens"); - Order(Before = PredefinedAdornmentLayers.Text); - TextViewRole(PredefinedTextViewRoles.Document)>] - member val LineLensAdornmentLayerDefinition : AdornmentLayerDefinition = null with get, set - - interface IViewTaggerProvider with - override __.CreateTagger(view, buffer) = - if settings.CodeLens.Enabled && not settings.CodeLens.ReplaceWithLineLens then - let wpfView = - match view with - | :? IWpfTextView as view -> view - | _ -> failwith "error" - - box(addCodeLensProviderOnce wpfView buffer) :?> _ - else - null - - interface IWpfTextViewCreationListener with - override __.TextViewCreated view = - if settings.CodeLens.Enabled && settings.CodeLens.ReplaceWithLineLens then - addLineLensProviderOnce view (view.TextBuffer) |> ignore \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs deleted file mode 100644 index 389d50b3cba..00000000000 --- a/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs +++ /dev/null @@ -1,91 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open System -open System.ComponentModel.Composition - -open Microsoft.VisualStudio -open Microsoft.VisualStudio.Editor -open Microsoft.VisualStudio.OLE.Interop -open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.TextManager.Interop -open Microsoft.VisualStudio.Utilities -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop -open Microsoft.VisualStudio.FSharp.Interactive - -type internal FsiCommandFilter(serviceProvider: System.IServiceProvider) = - - let loadPackage (guidString: string) = - lazy( - let shell = serviceProvider.GetService(typeof) :?> IVsShell - let packageToBeLoadedGuid = ref (Guid(guidString)) - match shell.LoadPackage packageToBeLoadedGuid with - | VSConstants.S_OK, pkg -> - pkg :?> Package - | _ -> null) - - let fsiPackage = loadPackage FSharpConstants.fsiPackageGuidString - - let mutable nextTarget = null - - member x.AttachToViewAdapter (viewAdapter: IVsTextView) = - match viewAdapter.AddCommandFilter x with - | VSConstants.S_OK, next -> - nextTarget <- next - | errorCode, _ -> - ErrorHandler.ThrowOnFailure errorCode |> ignore - - interface IOleCommandTarget with - member x.Exec (pguidCmdGroup, nCmdId, nCmdexecopt, pvaIn, pvaOut) = - if pguidCmdGroup = VSConstants.VsStd11 && nCmdId = uint32 VSConstants.VSStd11CmdID.ExecuteSelectionInInteractive then - Hooks.OnMLSend fsiPackage.Value FsiEditorSendAction.ExecuteSelection null null - VSConstants.S_OK - elif pguidCmdGroup = VSConstants.VsStd11 && nCmdId = uint32 VSConstants.VSStd11CmdID.ExecuteLineInInteractive then - Hooks.OnMLSend fsiPackage.Value FsiEditorSendAction.ExecuteLine null null - VSConstants.S_OK - elif pguidCmdGroup = Guids.guidInteractive && nCmdId = uint32 Guids.cmdIDDebugSelection then - Hooks.OnMLSend fsiPackage.Value FsiEditorSendAction.DebugSelection null null - VSConstants.S_OK - elif not (isNull nextTarget) then - nextTarget.Exec(&pguidCmdGroup, nCmdId, nCmdexecopt, pvaIn, pvaOut) - else - VSConstants.E_FAIL - - member x.QueryStatus (pguidCmdGroup, cCmds, prgCmds, pCmdText) = - if pguidCmdGroup = VSConstants.VsStd11 then - for i = 0 to int cCmds-1 do - if prgCmds.[i].cmdID = uint32 VSConstants.VSStd11CmdID.ExecuteSelectionInInteractive then - prgCmds.[i].cmdf <- uint32 (OLECMDF.OLECMDF_SUPPORTED ||| OLECMDF.OLECMDF_ENABLED) - elif prgCmds.[i].cmdID = uint32 VSConstants.VSStd11CmdID.ExecuteLineInInteractive then - prgCmds.[i].cmdf <- uint32 (OLECMDF.OLECMDF_SUPPORTED ||| OLECMDF.OLECMDF_ENABLED ||| OLECMDF.OLECMDF_DEFHIDEONCTXTMENU) - VSConstants.S_OK - elif pguidCmdGroup = Guids.guidInteractive then - for i = 0 to int cCmds-1 do - if prgCmds.[i].cmdID = uint32 Guids.cmdIDDebugSelection then - let dbgState = Hooks.GetDebuggerState fsiPackage.Value - if dbgState = FsiDebuggerState.AttachedNotToFSI then - prgCmds.[i].cmdf <- uint32 OLECMDF.OLECMDF_INVISIBLE - else - prgCmds.[i].cmdf <- uint32 (OLECMDF.OLECMDF_SUPPORTED ||| OLECMDF.OLECMDF_ENABLED) - VSConstants.S_OK - elif not (isNull nextTarget) then - nextTarget.QueryStatus(&pguidCmdGroup, cCmds, prgCmds, pCmdText) - else - VSConstants.E_FAIL - -[)>] -[] -[] -type internal FsiCommandFilterProvider [] - ([)>] serviceProvider: System.IServiceProvider, - editorFactory: IVsEditorAdaptersFactoryService) = - interface IWpfTextViewCreationListener with - member __.TextViewCreated(textView) = - match editorFactory.GetViewAdapter(textView) with - | null -> () - | textViewAdapter -> - let commandFilter = FsiCommandFilter serviceProvider - commandFilter.AttachToViewAdapter textViewAdapter - \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs index 11922d0d0d0..8e22a3fb99a 100644 --- a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs +++ b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs @@ -19,7 +19,7 @@ open FSharp.Compiler.SourceCodeServices type internal XmlDocCommandFilter ( - wpfTextView: IWpfTextView, + wpfTextView: ICocoaTextView, filePath: string, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, @@ -126,7 +126,7 @@ type internal XmlDocCommandFilterProvider workspace: VisualStudioWorkspaceImpl, textDocumentFactoryService: ITextDocumentFactoryService, editorFactory: IVsEditorAdaptersFactoryService) = - interface IWpfTextViewCreationListener with + interface ICocoaTextViewCreationListener with member __.TextViewCreated(textView) = match editorFactory.GetViewAdapter(textView) with | null -> () diff --git a/vsintegration/src/FSharp.Editor/Common/AssemblyInfo.fs b/vsintegration/src/FSharp.Editor/Common/AssemblyInfo.fs deleted file mode 100644 index 124f3de404c..00000000000 --- a/vsintegration/src/FSharp.Editor/Common/AssemblyInfo.fs +++ /dev/null @@ -1,11 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open Microsoft.VisualStudio.Shell - -// This is needed to load XAML resource dictionaries from FSharp.UIResources assembly because ProvideCodeBase attribute does not work for that purpose. -// This adds $PackageFolder$ to the directories probed for assemblies to load. -// The attribute is inexplicably class-targeted, hence the dummy class. -[] -type private BindingPathForUIResources = class end diff --git a/vsintegration/src/FSharp.Editor/Common/CompilerArguments.fs b/vsintegration/src/FSharp.Editor/Common/CompilerArguments.fs new file mode 100644 index 00000000000..e274ce4e952 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/CompilerArguments.fs @@ -0,0 +1,382 @@ +// -------------------------------------------------------------------------------------- +// Common utilities for environment, debugging and working with project files +// -------------------------------------------------------------------------------------- + +namespace MonoDevelop.FSharp + +open System +open System.IO +open System.Reflection +open System.Globalization +open System.Runtime.Versioning +open System.Threading +open System.Threading.Tasks +open MonoDevelop.Projects +open MonoDevelop.Ide +open MonoDevelop.Core.Assemblies +open MonoDevelop.Core +//open ExtCore +//open ExtCore.Control +open FSharp.Compiler.SourceCodeServices +open Microsoft.VisualStudio.FSharp.Editor.Pervasive +// -------------------------------------------------------------------------------------- +// Common utilities for working with files & extracting information from +// MonoDevelop objects (e.g. references, project items etc.) +// -------------------------------------------------------------------------------------- + +module CompilerArguments = + + /// Wraps the given string between double quotes + let wrapFile (s:string) = if s.StartsWith "\"" then s else "\"" + s + "\"" + + // Translate the target framework to an enum used by FSharp.CompilerBinding + let getTargetFramework (targetFramework:TargetFrameworkMoniker) = + if targetFramework = TargetFrameworkMoniker.NET_3_5 then FSharpTargetFramework.NET_3_5 + elif targetFramework = TargetFrameworkMoniker.NET_3_0 then FSharpTargetFramework.NET_3_0 + elif targetFramework = TargetFrameworkMoniker.NET_2_0 then FSharpTargetFramework.NET_2_0 + elif targetFramework = TargetFrameworkMoniker.NET_4_0 then FSharpTargetFramework.NET_4_0 + elif targetFramework = TargetFrameworkMoniker.NET_4_5 then FSharpTargetFramework.NET_4_5 + elif targetFramework = TargetFrameworkMoniker.NET_4_6 then FSharpTargetFramework.NET_4_6 + elif targetFramework = TargetFrameworkMoniker.NET_4_6_1 then FSharpTargetFramework.NET_4_6_1 + elif targetFramework = TargetFrameworkMoniker.NET_4_6_2 then FSharpTargetFramework.NET_4_6_2 + else FSharpTargetFramework.NET_4_6_2 + + module Project = + ///Use the IdeApp.Workspace active configuration failing back to proj.DefaultConfiguration then ConfigurationSelector.Default + let getCurrentConfigurationOrDefault (proj:Project) = + match IdeApp.Workspace with + | ws when ws <> null && ws.ActiveConfiguration <> null -> ws.ActiveConfiguration + | _ -> if proj <> null then proj.DefaultConfiguration.Selector + else ConfigurationSelector.Default + + let isPortable (project: DotNetProject) = + not (String.IsNullOrEmpty project.TargetFramework.Id.Profile) + + let isDotNetCoreProject (project:DotNetProject) = + let properties = project.MSBuildProject.EvaluatedProperties + properties.HasProperty ("TargetFramework") || properties.HasProperty ("TargetFrameworks") + + let getDefaultTargetFramework (runtime:TargetRuntime) = + let newest_net_framework_folder (best:TargetFramework,best_version:int[]) (candidate_framework:TargetFramework) = + if runtime.IsInstalled(candidate_framework) && candidate_framework.Id.Identifier = TargetFrameworkMoniker.ID_NET_FRAMEWORK then + let version = candidate_framework.Id.Version + let parsed_version_s = (if version.[0] = 'v' then version.[1..] else version).Split('.') + let parsed_version = + try + Array.map int parsed_version_s + with + | _ -> [| 0 |] + let mutable level = 0 + let mutable cont = true + let min_level = min parsed_version.Length best_version.Length + let mutable new_best = false + while cont && level < min_level do + if parsed_version.[level] > best_version.[level] then + new_best <- true + cont <- false + elif best_version.[level] > parsed_version.[level] then + cont <- false + else + cont <- true + level <- level + 1 + if new_best then + (candidate_framework, parsed_version) + else + (best,best_version) + else + (best,best_version) + let candidate_frameworks = MonoDevelop.Core.Runtime.SystemAssemblyService.GetTargetFrameworks() + let first = Seq.head candidate_frameworks + let best_info = Seq.fold newest_net_framework_folder (first,[| 0 |]) candidate_frameworks + fst best_info + + module ReferenceResolution = + + let tryGetDefaultReference langVersion targetFramework filename (extrapath: string option) = + let dirs = + match extrapath with + | Some path -> path :: FSharpEnvironment.getDefaultDirectories(langVersion, targetFramework) + | None -> FSharpEnvironment.getDefaultDirectories(langVersion, targetFramework) + FSharpEnvironment.resolveAssembly dirs filename + + let resolutionFailedMessage (n:string) = String.Format ("Resolution: Assembly resolution failed when trying to find default reference for: {0}", n) + /// Generates references for the current project & configuration as a + /// list of strings of the form [ "-r:"; ... ] + let generateReferences (project: DotNetProject, projectAssemblyReferences: AssemblyReference seq, langVersion, targetFramework, shouldWrap) = + [ + let wrapf = if shouldWrap then wrapFile else id + + let getAbsolutePath (ref:AssemblyReference) = + let assemblyPath = ref.FilePath + if assemblyPath.IsAbsolute then + assemblyPath.FullPath |> string + else + let s = Path.Combine(project.FileName.ParentDirectory.ToString(), assemblyPath.ToString()) + Path.GetFullPath s + + let projectReferences = + projectAssemblyReferences + |> Seq.map getAbsolutePath + |> Seq.distinct + + let find assemblyName= + projectReferences + |> Seq.tryFind (fun fn -> fn.EndsWith(assemblyName + ".dll", true, CultureInfo.InvariantCulture) + || fn.EndsWith(assemblyName, true, CultureInfo.InvariantCulture)) + + + // If 'mscorlib.dll' or 'FSharp.Core.dll' is not in the set of references, we try to resolve and add them. + match find "FSharp.Core", find "mscorlib", Project.isDotNetCoreProject project with + | None, Some mscorlib, false -> + // if mscorlib is found without FSharp.Core yield fsharp.core in the same base dir as mscorlib + // falling back to one of the default directories + let extraPath = Some (Path.GetDirectoryName (mscorlib)) + match ReferenceResolution.tryGetDefaultReference langVersion targetFramework "FSharp.Core" extraPath with + | Some ref -> yield "-r:" + wrapf(ref) + | None -> LoggingService.LogWarning(resolutionFailedMessage "FSharp.Core") + | None, None, false -> + // If neither are found yield the default fsharp.core + match ReferenceResolution.tryGetDefaultReference langVersion targetFramework "FSharp.Core" None with + | Some ref -> yield "-r:" + wrapf(ref) + | None -> LoggingService.LogWarning(resolutionFailedMessage "FSharp.Core") + | _ -> () // found them both, no action needed + + let needsFacades = + projectReferences + |> Seq.exists(fun reference -> TaskUtil.WaitAndGetResult(SystemAssemblyService.RequiresFacadeAssembliesAsync(reference), Async.DefaultCancellationToken)) + + if needsFacades then + LoggingService.LogInfo("Found PCLv2 assembly."); + + let facades = project.TargetRuntime.FindFacadeAssembliesForPCL(project.TargetFramework) + for facade in facades do + yield "-r:" + wrapf(facade) + + for file in projectReferences do + yield "-r:" + wrapf(file) ] + + let generateDebug (config:FSharpCompilerParameters) = + match config.ParentConfiguration.DebugSymbols, config.ParentConfiguration.DebugType with + | true, typ -> + match typ with + | "full" -> "--debug:full" + | "pdbonly" -> "--debug:pdbonly" + | _ -> "--debug+" + | false, _ -> "--debug-" + + let getSharedAssetFilesFromReferences (project:DotNetProject) = + project.References + |> Seq.filter (fun r -> r.ExtendedProperties.Contains("MSBuild.SharedAssetsProject")) + |> Seq.collect (fun r -> (r.ResolveProject project.ParentSolution).Files) + |> Seq.map (fun f -> f.FilePath) + |> Set.ofSeq + + let getCompiledFiles project = + let sharedAssetFiles = getSharedAssetFilesFromReferences project + + project.Files + // Shared Asset files need to be referenced first + |> Seq.sortByDescending (fun f -> sharedAssetFiles.Contains f.FilePath) + |> Seq.filter(fun f -> f.FilePath.Extension = ".fs" || f.FilePath.Extension = ".fsi") + |> Seq.map(fun f -> f.Name) + |> Seq.distinct + + /// Generates command line options for the compiler specified by the + /// F# compiler options (debugging, tail-calls etc.), custom command line + /// parameters and assemblies referenced by the project ("-r" options) + let generateCompilerOptions (project:DotNetProject, projectAssemblyReferences: AssemblyReference seq, fsconfig:FSharpCompilerParameters, reqLangVersion, targetFramework, configSelector, shouldWrap) = + let dashr = generateReferences (project, projectAssemblyReferences, reqLangVersion, targetFramework, shouldWrap) |> Array.ofSeq + + let splitByChars (chars: char array) (s:string) = + s.Split(chars, StringSplitOptions.RemoveEmptyEntries) + + let defines = fsconfig.GetDefineSymbols() + [ + yield "--simpleresolution" + yield "--noframework" + let outputFile = project.GetOutputFileName(configSelector).ToString() + if not (String.IsNullOrWhiteSpace outputFile) then + yield "--out:" + outputFile + if Project.isPortable project || Project.isDotNetCoreProject project then + yield "--targetprofile:netcore" + if not (String.IsNullOrWhiteSpace fsconfig.PlatformTarget) then + yield "--platform:" + fsconfig.PlatformTarget + yield "--fullpaths" + yield "--flaterrors" + for symbol in defines do yield "--define:" + symbol + yield if fsconfig.HasDefineSymbol "DEBUG" then "--debug+" else "--debug-" + yield "--optimize-" + yield "--tailcalls+" + if not (String.IsNullOrWhiteSpace fsconfig.DebugType) then + yield sprintf "--debug:%s" fsconfig.DebugType + yield match project.CompileTarget with + | CompileTarget.Library -> "--target:library" + | CompileTarget.Module -> "--target:module" + | _ -> "--target:exe" + yield if fsconfig.TreatWarningsAsErrors then "--warnaserror+" else "--warnaserror-" + yield sprintf "--warn:%d" fsconfig.WarningLevel + if not (String.IsNullOrWhiteSpace fsconfig.NoWarn) then + for arg in fsconfig.NoWarn |> splitByChars [|';'; ','|] do + yield "--nowarn:" + arg + // TODO: This currently ignores escaping using "..." + for arg in fsconfig.OtherFlags |> splitByChars [|' '|] do + yield arg + yield! dashr ] + + let generateProjectOptions (project:DotNetProject, projectAssemblyReferences: AssemblyReference seq, fsconfig:FSharpCompilerParameters, reqLangVersion, targetFramework, configSelector, shouldWrap) = + let compilerOptions = generateCompilerOptions (project, projectAssemblyReferences, fsconfig, reqLangVersion, targetFramework, configSelector, shouldWrap) |> Array.ofSeq + let loadedTimeStamp = DateTime.MaxValue // Not 'now', we don't want to force reloading + { ProjectFileName = project.FileName.FullPath.ToString() + SourceFiles = [| yield! (getCompiledFiles project) |] + Stamp = None + OtherOptions = compilerOptions + ReferencedProjects = [| |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = loadedTimeStamp + UnresolvedReferences = None + OriginalLoadReferences = [] + ExtraProjectInfo = None + ProjectId = None } + + /// Get source files of the current project (returns files that have + /// build action set to 'Compile', but not e.g. scripts or resources) + let getSourceFiles (items:ProjectItemCollection) = + [ for file in items.GetAll() do + if file.BuildAction = "Compile" && file.Subtype <> Subtype.Directory then + yield file.FilePath.FullPath.ToString() ] + + + /// Generate inputs for the compiler (excluding source code!); returns list of items + /// containing resources (prefixed with the --resource parameter) + let generateOtherItems (items:ProjectItemCollection) = + [ for file in items.GetAll() do + match file.BuildAction with + | _ when file.Subtype = Subtype.Directory -> () + | "EmbeddedResource" -> + let fileName = file.Name.ToString() + let logicalResourceName = file.ProjectVirtualPath.ToString().Replace("\\",".").Replace("/",".") + yield "--resource:" + wrapFile fileName + "," + wrapFile logicalResourceName + | "None" | "Content" | "Compile" -> () + | _ -> ()] // failwith("Items of type '" + s + "' not supported") ] + + let private getToolPath (pathsToSearch:seq) (extensions:seq) (toolName:string) = + let filesToSearch = Seq.map (fun x -> toolName + x) extensions + + let tryFindPathAndFile (filesToSearch:seq) (path:string) = + try + let candidateFiles = Directory.GetFiles(path) + + let fileIfExists candidateFile = + Seq.tryFind (fun x -> Path.Combine(path,x) = candidateFile) filesToSearch + match Seq.tryPick fileIfExists candidateFiles with + | Some x -> Some(path,x) + | None -> None + + with + | e -> None + + Seq.tryPick (tryFindPathAndFile filesToSearch) pathsToSearch + + /// Get full path to tool + let getEnvironmentToolPath (runtime:TargetRuntime) (framework:TargetFramework) (extensions:seq) (toolName:string) = + + let pathsToSearch = runtime.GetToolsPaths(framework) + getToolPath pathsToSearch extensions toolName + + let private getShellToolPath (extensions:seq) (toolName:string) = + let pathVariable = Environment.GetEnvironmentVariable("PATH") + let searchPaths = pathVariable.Split [| IO.Path.PathSeparator |] + getToolPath searchPaths extensions toolName + + let getDefaultInteractive() = + + let runtime = IdeApp.Preferences.DefaultTargetRuntime.Value + let framework = Project.getDefaultTargetFramework runtime + + match getEnvironmentToolPath runtime framework [|""; ".exe"; ".bat" |] "fsharpi" with + | Some(dir,file)-> Some(Path.Combine(dir,file)) + | None-> + match getShellToolPath [| ""; ".exe"; ".bat" |] "fsharpi" with + | Some(dir,file)-> Some(Path.Combine(dir,file)) + | None-> + match getEnvironmentToolPath runtime framework [|""; ".exe"; ".bat" |] "fsi" with + | Some(dir,file)-> Some(Path.Combine(dir,file)) + | None-> + match getShellToolPath [| ""; ".exe"; ".bat" |] "fsi" with + | Some(dir,file)-> Some(Path.Combine(dir,file)) + | None-> + match FSharpEnvironment.BinFolderOfDefaultFSharpCompiler None with + | Some(dir) when FSharpEnvironment.safeExists(Path.Combine(dir, "fsi.exe")) -> + Some(Path.Combine(dir,"fsi.exe")) + | _ -> None + + let getCompilerFromEnvironment (runtime:TargetRuntime) (framework:TargetFramework) = + match getEnvironmentToolPath runtime framework [| ""; ".exe"; ".bat" |] "fsharpc" with + | Some(dir,file) -> Some(Path.Combine(dir,file)) + | None -> + match getEnvironmentToolPath runtime framework [| ""; ".exe"; ".bat" |] "fsc" with + | Some(dir,file) -> Some(Path.Combine(dir,file)) + | None -> None + + // Only used when xbuild support is not enabled. When xbuild is enabled, the .targets + // file finds FSharp.Build.dll which finds the F# compiler. + let getDefaultFSharpCompiler() = + + let runtime = IdeApp.Preferences.DefaultTargetRuntime.Value + let framework = Project.getDefaultTargetFramework runtime + + match getCompilerFromEnvironment runtime framework with + | Some(result)-> Some(result) + | None-> + match getShellToolPath [| ""; ".exe"; ".bat" |] "fsharpc" with + | Some(dir,file) -> Some(Path.Combine(dir,file)) + | None -> + match getShellToolPath [| ""; ".exe"; ".bat" |] "fsc" with + | Some(dir,file) -> Some(Path.Combine(dir,file)) + | None -> + match FSharpEnvironment.BinFolderOfDefaultFSharpCompiler None with + | Some(dir) when FSharpEnvironment.safeExists(Path.Combine(dir, "fsc.exe")) -> + Some(Path.Combine(dir,"fsc.exe")) + | _ -> None + + let getDefineSymbols (fileName:string) (project: Project) = + [if FileSystem.IsAScript fileName + then yield! ["INTERACTIVE";"EDITING"] + else yield! ["COMPILED";"EDITING"] + + let configuration = + match IdeApp.Workspace |> Option.ofObj, project |> Option.ofObj with + | None, Some proj -> + //as there is no workspace use the default configuration for the project + Some (proj.GetConfiguration(proj.DefaultConfiguration.Selector)) + | Some workspace, Some project -> + Some (project.GetConfiguration(workspace.ActiveConfiguration)) + | _ -> None + + match configuration with + | Some config -> + match config with + | :? DotNetProjectConfiguration as config -> yield! config.GetDefineSymbols() + | _ -> () + | None -> () ] + + let getConfig() = + match MonoDevelop.Ide.IdeApp.Workspace with + | ws when ws <> null && ws.ActiveConfiguration <> null -> ws.ActiveConfiguration + | _ -> MonoDevelop.Projects.ConfigurationSelector.Default + + let getArgumentsFromProject (proj:DotNetProject) (config:ConfigurationSelector) (referencedAssemblies) = + let projConfig = proj.GetConfiguration(config) :?> DotNetProjectConfiguration + let fsconfig = projConfig.CompilationParameters :?> FSharpCompilerParameters + generateProjectOptions (proj, referencedAssemblies, fsconfig, None, getTargetFramework projConfig.TargetFramework.Id, config, false) + //maybe { + // let! projConfig = proj.GetConfiguration(config) |> Option.tryCast + // let! fsconfig = projConfig.CompilationParameters |> Option.tryCast + // return generateProjectOptions (proj, referencedAssemblies, fsconfig, None, getTargetFramework projConfig.TargetFramework.Id, config, false) + //} + + let getReferencesFromProject (proj:DotNetProject, config:ConfigurationSelector, referencedAssemblies) = + let projConfig = proj.GetConfiguration(config) :?> DotNetProjectConfiguration + generateReferences(proj, referencedAssemblies, None, getTargetFramework projConfig.TargetFramework.Id, false) + diff --git a/vsintegration/src/FSharp.Editor/Common/CompilerLocationUtils.fs b/vsintegration/src/FSharp.Editor/Common/CompilerLocationUtils.fs new file mode 100644 index 00000000000..9ea5a3a9745 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/CompilerLocationUtils.fs @@ -0,0 +1,423 @@ +namespace MonoDevelop.FSharp + +open System +open System.IO +open System.Configuration +open System.Reflection +open System.Runtime.InteropServices +open System.Text.RegularExpressions +open MonoDevelop.Core + +#nowarn "44" // ConfigurationSettings is obsolete but the new stuff is horribly complicated. + +module Environment = + /// Are we running on the Mono platform? + let runningOnMono = + try System.Type.GetType("Mono.Runtime") <> null + with _ -> false + + let getMonoPath() = + if File.Exists "/Library/Frameworks/Mono.framework/Commands/mono" then + "/Library/Frameworks/Mono.framework/Commands/mono" + else + "mono" + +/// Target framework (used to find the right version of F# binaries) +type FSharpTargetFramework = + | NET_2_0 + | NET_3_0 + | NET_3_5 + | NET_4_0 + | NET_4_5 + | NET_4_5_1 + | NET_4_5_2 + | NET_4_6 + | NET_4_6_1 + | NET_4_6_2 + | NET_4_7 + +type FSharpCompilerVersion = + // F# 2.0 + | FSharp_2_0 + // F# 3.0 + | FSharp_3_0 + // F# 3.1 + | FSharp_3_1 + override x.ToString() = match x with | FSharp_2_0 -> "4.0.0.0" | FSharp_3_0 -> "4.3.0.0" | FSharp_3_1 -> "4.3.1.0" + /// The current requested language version can be overriden by the user using environment variable. + static member LatestKnown = + match System.Environment.GetEnvironmentVariable("FSHARP_PREFERRED_VERSION") with + | null -> FSharp_3_1 + | "4.0.0.0" -> FSharp_2_0 + | "4.3.0.0" -> FSharp_3_0 + | "4.3.1.0" -> FSharp_3_1 + | _ -> FSharp_3_1 + +module FSharpEnvironment = + + let fsharpVers = [ FSharp_3_1; FSharp_3_0; FSharp_2_0 ] + + let safeExists f = (try File.Exists(f) with _ -> false) + + let FSharpCoreLibRunningVersion = + try + match (typeof>).Assembly.GetName().Version.ToString() with + | null -> None + | "" -> None + | s -> Some(s) + with _ -> None + + // Returns: + // -- on 2.0: "v2.0.50727" + // -- on 4.0: "v4.0.30109" (last 5 digits vary by build) + let MSCorLibRunningRuntimeVersion = + typeof.Assembly.ImageRuntimeVersion + + // The F# team version number. This version number is used for + // - the F# version number reported by the fsc.exe and fsi.exe banners in the CTP release + // - the F# version number printed in the HTML documentation generator + // - the .NET DLL version number for all VS2008 DLLs + // - the VS2008 registry key, written by the VS2008 installer + // HKEY_LOCAL_MACHINE\Software\Microsoft\.NETFramework\AssemblyFolders\Microsoft.FSharp-" + FSharpTeamVersionNumber + // Also for Beta2, the language revision number indicated on the F# language spec + // + // It is NOT the version number listed on FSharp.Core.dll + let FSharpTeamVersionNumber = "2.0.0.0" + + // The F# binary format revision number. The first three digits of this form the significant part of the + // format revision number for F# binary signature and optimization metadata. The last digit is not significant. + // + // WARNING: Do not change this revision number unless you absolutely know what you're doing. + let FSharpBinaryMetadataFormatRevision = "2.0.0.0" + + [] + extern uint32 RegOpenKeyExW(UIntPtr _hKey, string _lpSubKey, uint32 _ulOptions, int _samDesired, UIntPtr & _phkResult); + + [] + extern uint32 RegQueryValueExW(UIntPtr _hKey, string _lpValueName, uint32 _lpReserved, uint32 & _lpType, IntPtr _lpData, int & _lpchData); + + [] + extern uint32 RegCloseKey(UIntPtr _hKey) + + // MaxPath accounts for the null-terminating character, for example, the maximum path on the D drive is "D:\<256 chars>\0". + // See: ndp\clr\src\BCL\System\IO\Path.cs + let maxPath = 260 + let maxDataLength = (new System.Text.UTF32Encoding()).GetMaxByteCount(maxPath) + let KEY_WOW64_DEFAULT = 0x0000 + let KEY_WOW64_32KEY = 0x0200 + let HKEY_LOCAL_MACHINE = UIntPtr(0x80000002u) + let KEY_QUERY_VALUE = 0x1 + let REG_SZ = 1u + + //let GetDefaultRegistryStringValueViaDotNet(subKey: string) = + //Option.ofString + //(try + // downcast Microsoft.Win32.Registry.GetValue("HKEY_LOCAL_MACHINE\\"+subKey,null,null) + //with e-> + //System.Diagnostics.Debug.Assert(false, sprintf "Failed in GetDefaultRegistryStringValueViaDotNet: %s" (e.ToString())) + //null) + + //let Get32BitRegistryStringValueViaPInvoke(subKey:string) = + //Option.ofString + //(try + // // 64 bit flag is not available <= Win2k + // let options = + // match Environment.OSVersion.Version.Major with + // | major when major >= 5 -> KEY_WOW64_32KEY + // | _ -> KEY_WOW64_DEFAULT + + + // let mutable hkey = UIntPtr.Zero; + // let pathResult = Marshal.AllocCoTaskMem(maxDataLength); + + // try + // let res = RegOpenKeyExW(HKEY_LOCAL_MACHINE,subKey, 0u, KEY_QUERY_VALUE ||| options, & hkey) + // if res = 0u then + // let mutable uType = REG_SZ; + // let mutable cbData = maxDataLength; + + // let res = RegQueryValueExW(hkey, null, 0u, &uType, pathResult, &cbData); + + // if (res = 0u && cbData > 0 && cbData <= maxDataLength) then + // Marshal.PtrToStringUni(pathResult, (cbData - 2)/2); + // else + // null + // else + // null + // finally + // if hkey <> UIntPtr.Zero then + // RegCloseKey(hkey) |> ignore + + // if pathResult <> IntPtr.Zero then + // Marshal.FreeCoTaskMem(pathResult) + //with e-> + //System.Diagnostics.Debug.Assert(false, sprintf "Failed in Get32BitRegistryStringValueViaPInvoke: %s" (e.ToString())) + //null) + +// let is32Bit = IntPtr.Size = 4 + +// let tryRegKey(subKey:string) = + +// if is32Bit then +// let s = GetDefaultRegistryStringValueViaDotNet(subKey) +// // If we got here AND we're on a 32-bit OS then we can validate that Get32BitRegistryStringValueViaPInvoke(...) works +// // by comparing against the result from GetDefaultRegistryStringValueViaDotNet(...) +//#if DEBUG +// let viaPinvoke = Get32BitRegistryStringValueViaPInvoke(subKey) +// System.Diagnostics.Debug.Assert((s = viaPinvoke), sprintf "32bit path: pi=%A def=%A" viaPinvoke s) +//#endif + // s + //else + //Get32BitRegistryStringValueViaPInvoke(subKey) + + let internal tryCurrentDomain() = + let pathFromCurrentDomain = System.AppDomain.CurrentDomain.BaseDirectory + if not(String.IsNullOrEmpty(pathFromCurrentDomain)) then + Some pathFromCurrentDomain + else + None + + let internal tryAppConfig (appConfigKey:string) = + + let locationFromAppConfig = ConfigurationSettings.AppSettings.[appConfigKey] + System.Diagnostics.Debug.Print(sprintf "Considering appConfigKey %s which has value '%s'" appConfigKey locationFromAppConfig) + + if String.IsNullOrEmpty(locationFromAppConfig) then + None + else + let exeAssemblyFolder = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) + let locationFromAppConfig = locationFromAppConfig.Replace("{exepath}", exeAssemblyFolder) + System.Diagnostics.Debug.Print(sprintf "Using path %s" locationFromAppConfig) + Some locationFromAppConfig + + /// Try to find the F# compiler location by looking at the "fsharpi" script installed by F# packages + let internal tryFsharpiScript(url:string) = + try + let str = File.ReadAllText(url) + let reg = new Regex("mono.* (\/.*)\/fsi\.exe") + let res = reg.Match(str) + if res.Success then Some(res.Groups.[1].Value) else None + with e -> + None + + let BackupInstallationProbePoints = + [ // prefer the latest installation of Mono on Mac + "/Library/Frameworks/Mono.framework/Versions/Current" + // prefer freshly built F# compilers on Linux + "/usr/local" + // otherwise look in the standard place + "/usr" ] + + //let tryWindowsConfig (reqLangVersion: FSharpCompilerVersion) = + ////early termination on Mono, continuing here results in failed pinvokes and reg key failures ~18-35ms + //if Environment.runningOnMono then None else + //// On windows the location of the compiler is via a registry key + //let key20 = @"Software\Microsoft\.NETFramework\AssemblyFolders\Microsoft.FSharp-" + FSharpTeamVersionNumber + //let key40 = match reqLangVersion with + // | FSharp_2_0 -> @"Software\Microsoft\FSharp\2.0\Runtime\v4.0" + // | FSharp_3_0 -> @"Software\Microsoft\FSharp\3.0\Runtime\v4.0" + // | FSharp_3_1 -> @"Software\Microsoft\FSharp\3.1\Runtime\v4.0" + + //let key1,key2 = match FSharpCoreLibRunningVersion with + // | None -> key20,key40 + // | Some v -> if v.Length > 1 && v.[0] <= '3' then key20,key40 + // else key40,key20 + + //LoggingService.LogDebug(sprintf "BinFolderOfDefaultFSharpCore: Probing registry key %s" key1) + //let result = tryRegKey key1 + //match result with + //| Some _ -> result + //| None -> LoggingService.LogDebug(sprintf "Resolution: BinFolderOfDefaultFSharpCore: Probing registry key %s" key2) + //tryRegKey key2 + + let tryUnixConfig() = + // On Unix we let you set FSHARP_COMILER_BIN. I've rarely seen this used and its not documented in the install isntructions. + LoggingService.LogDebug(sprintf "Resolution: BinFolderOfDefaultFSharpCore: Probing environment variable FSHARP_COMPILER_BIN") + let result = + let var = System.Environment.GetEnvironmentVariable("FSHARP_COMPILER_BIN") + if String.IsNullOrEmpty(var) then None + else Some(var) + + match result with + | Some _ -> result + | None -> + + // On Unix we probe 'bin' under various hardwired paths for the scripts 'fsharpc' and 'fsharpi'. + // We then loko in the script to see the Mono location it is pointing to. + // This is pretty fragile, e.g. the script lookup is done via a regular expression. + // Really we should just search the path or otherwise resolve the 'mono' command? + BackupInstallationProbePoints + |> List.tryPick (fun x -> + LoggingService.LogDebug(sprintf "Resolution: BinFolderOfDefaultFSharpCore: Probing %s" x) + let file f = Path.Combine(Path.Combine(x,"bin"),f) + let exists f = safeExists(file f) + match (if exists "fsc" && exists "fsi" then tryFsharpiScript (file "fsi") else None) with + | Some res -> Some res + | None -> if exists "fsharpc" && exists "fsharpi" then tryFsharpiScript (file "fsharpi") + else None) + + + // The default location of FSharp.Core.dll and fsc.exe based on the version of fsc.exe that is running + // Used for + // - location of design-time copies of FSharp.Core.dll and FSharp.Compiler.Interactive.Settings.dll for the default assumed environment for scripts + // - default ToolPath in tasks in FSharp.Build.dll (for Fsc tasks) + // - default F# binaries directory in service.fs (REVIEW: check this) + // - default location of fsi.exe in FSharp.VS.FSI.dll + // - default location of fsc.exe in FSharp.Compiler.CodeDom.dll + let BinFolderOfDefaultFSharpCompiler(reqLangVersion: Option) = + + let getBinFolder(reqLangVersion: FSharpCompilerVersion) = + // Check for an app.config setting to redirect the default compiler location + // Like fsharp-compiler-location + try + // FSharp.Compiler support setting an appkey for compiler location. I've never seen this used. + LoggingService.LogDebug("Resolution:BinFolderOfDefaultFSharpCore: Probing app.config") + let result = tryAppConfig "fsharp-compiler-location" + match result with + | Some _ -> result + + + | None -> + let result = tryUnixConfig() + match result with + | Some _ -> result + | None -> None + //| None -> let result = tryWindowsConfig reqLangVersion + //match result with + //| Some _ -> result + //| None -> let result = tryUnixConfig() + //match result with + //| Some _ -> result + //| None -> None + with e -> + System.Diagnostics.Debug.Assert(false, "Error while determining default location of F# compiler") + LoggingService.LogDebug(sprintf "Resolution: BinFolderOfDefaultFSharpCore: error %s" (e.ToString())) + None + + match reqLangVersion with + | Some v -> getBinFolder v + | None -> List.tryPick getBinFolder fsharpVers + + let FolderOfDefaultFSharpCore(reqLangVersion:Option, targetFramework) = + + let getFolder reqLangVersion = + try + LoggingService.LogDebug(sprintf "Resolution: Determing folder of FSharp.Core for target framework '%A'" targetFramework) + let result = tryAppConfig "fsharp-core-location" + match result with + | Some _ -> result + //| None -> + + //// On Windows, look for the registry key giving the installation location of FSharp.Core.dll. + //// This only works for .NET 2.0 - 4.0. To target Silverlight or Portable you'll need to use a direct reference to + //// the right FSharp.Core.dll. + //let result = + // //early termination on Mono, continuing here results in failed pinvokes and reg key failures ~18-35ms + // if Environment.runningOnMono then None else + // match reqLangVersion, targetFramework with + // | FSharp_2_0, x when (x = NET_2_0 || x = NET_3_0 || x = NET_3_5) -> + // tryRegKey @"Software\Microsoft\.NETFramework\v2.0.50727\AssemblyFoldersEx\Microsoft Visual F# 4.0" + // | FSharp_2_0, _ -> + // tryRegKey @"Software\Microsoft\.NETFramework\v4.0.30319\AssemblyFoldersEx\Microsoft Visual F# 4.0" + // | FSharp_3_0, x when (x = NET_2_0 || x = NET_3_0 || x = NET_3_5) -> + // tryRegKey @"Software\Microsoft\.NETFramework\v2.0.50727\AssemblyFoldersEx\F# 3.0 Core Assemblies" + // | FSharp_3_0, NET_4_0 -> + // tryRegKey @"Software\Microsoft\.NETFramework\v4.0.30319\AssemblyFoldersEx\F# 3.0 Core Assemblies" + // | FSharp_3_0, NET_4_5 -> + // tryRegKey @"Software\Microsoft\.NETFramework\v4.5.50709\AssemblyFoldersEx\F# 3.0 Core Assemblies" + // | FSharp_3_1, NET_4_5 -> + // tryRegKey @"Software\Microsoft\.NETFramework\v4.5.50709\AssemblyFoldersEx\F# 3.1 Core Assemblies" + // | _ -> None + + //match result with + //| Some _ -> result + | None -> + LoggingService.LogDebug(sprintf "Resolution: FSharp.Core: looking in environment variable") + let result = + let var = System.Environment.GetEnvironmentVariable("FSHARP_CORE_LOCATION") + if String.IsNullOrEmpty(var) then None + else Some(var) + match result with + | Some _ -> result + | None -> + let possibleInstallationPoints = + Option.toList (BinFolderOfDefaultFSharpCompiler(Some reqLangVersion) |> Option.map Path.GetDirectoryName) @ + BackupInstallationProbePoints + LoggingService.LogDebug(sprintf "Resolution: targetFramework = %A" targetFramework) + let ext = + match targetFramework with + | NET_2_0 | NET_3_0 | NET_3_5 -> "2.0" + | NET_4_0 -> "4.0" + | NET_4_5 -> "4.5" + | NET_4_5_1 -> "4.5.1" + | NET_4_5_2 -> "4.5.2" + | NET_4_6 -> "4.6" + | NET_4_6_1 -> "4.6.1" + | NET_4_6_2 -> "4.6.2" + | NET_4_7 -> "4.7" + + let safeExists f = (try File.Exists(f) with _ -> false) + let result = + possibleInstallationPoints |> List.tryPick (fun possibleInstallationDir -> + LoggingService.LogDebug(sprintf "Resolution: Probing for %s/lib/mono/%s/FSharp.Core.dll" possibleInstallationDir ext) + let (++) s x = Path.Combine(s,x) + let candidate = possibleInstallationDir ++ "lib" ++ "mono" ++ ext + if safeExists (candidate ++ "FSharp.Core.dll") then + Some candidate + else + None) + + match result with + | Some _ -> result + | None -> + let result = + possibleInstallationPoints |> List.tryPick (fun possibleInstallationDir -> + + LoggingService.LogDebug(sprintf "Resolution: Probing %s/bin for fsc/fsi scripts or fsharpc/fsharpi scripts" possibleInstallationDir) + + let file f = Path.Combine(Path.Combine(possibleInstallationDir,"bin"),f) + let exists f = safeExists(file f) + match (if exists "fsc" && exists "fsi" then tryFsharpiScript (file "fsi") else None) with + | Some res -> Some res + | None -> + match (if exists "fsharpc" && exists "fsharpi" then tryFsharpiScript (file "fsharpi") else None) with + | Some res -> Some res + | None -> None) + + match result with + | Some _ -> result + | None -> None + + with e -> + System.Diagnostics.Debug.Assert(false, "Error while determining default location of F# compiler") + None + + match reqLangVersion with + | Some v -> getFolder v + | None -> List.tryPick getFolder fsharpVers + + /// Returns default directories to be used when searching for DLL files + let getDefaultDirectories(langVersion: Option<_>, fsTargetFramework) = + + let dir = + match langVersion with + | Some _ -> FolderOfDefaultFSharpCore(langVersion, fsTargetFramework) + | None -> List.tryPick (fun v -> FolderOfDefaultFSharpCore(Some v, fsTargetFramework)) fsharpVers + + // Return all known directories, get the location of the System DLLs + [ match dir with + | Some dir -> LoggingService.LogDebug(sprintf "Resolution: Using '%A' as the location of default FSharp.Core.dll" dir) + yield dir + | None -> LoggingService.LogDebug(sprintf "Resolution: Unable to find a default location for FSharp.Core.dll") + yield System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()] + + /// Resolve assembly in the specified list of directories + let rec resolveAssembly dirs asm = + match dirs with + | dir::dirs -> + let asmPath = Path.Combine(dir, asm) + let any = List.tryFind safeExists [ asmPath + ".dll" ] + match any with + | Some(file) -> Some(file) + | _ -> resolveAssembly dirs asm + | [] -> None diff --git a/vsintegration/src/FSharp.Editor/Common/CompilerService.fs b/vsintegration/src/FSharp.Editor/Common/CompilerService.fs new file mode 100644 index 00000000000..3d1702a89db --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/CompilerService.fs @@ -0,0 +1,183 @@ +// -------------------------------------------------------------------------------------- +// Compilation of projects - generates command line options for +// the compiler and parses compiler error messages +// -------------------------------------------------------------------------------------- + +namespace MonoDevelop.FSharp + +open System +open System.IO +open System.Diagnostics +open System.Text.RegularExpressions +open MonoDevelop.Core +open MonoDevelop.Core.Assemblies +open MonoDevelop.Projects +open MonoDevelop.Ide +open CompilerArguments +// -------------------------------------------------------------------------------------- + +/// Functions that implement compilation, parsing, etc.. +// +// NOTE: Only used when xbuild support is not enabled. When xbuild is enabled, the .targets file finds +// FSharp.Build.dll which finds the F# compiler and builds the compilation arguments. +module CompilerService = + /// Generate various command line arguments for the project + let private generateCmdArgs (config:DotNetProjectConfiguration, projReferencedAssemblies, regLangVersion, configSel) = + [ match config.CompileTarget with + | CompileTarget.Library -> yield "--target:library" + | CompileTarget.Module -> yield "--target:module" + | CompileTarget.WinExe -> yield "--target:winexe" + | (*CompileTarget.Exe*)_ -> yield "--target:exe" + + if config.SignAssembly then yield "--keyfile:" + CompilerArguments.wrapFile(config.AssemblyKeyFile.ToString()) + yield "--out:" + CompilerArguments.wrapFile (config.CompiledOutputName.ToString()) + + // Generate compiler options based on F# specific project settings + let fsconfig = config.CompilationParameters :?> FSharpCompilerParameters + + if not (String.IsNullOrEmpty fsconfig.DocumentationFile) then + let docFile = config.CompiledOutputName.ChangeExtension(".xml").ToString() + yield ("--doc:" + CompilerArguments.wrapFile docFile) + + let shouldWrap = true// The compiler argument paths should always be wrapped, since some paths (ie. on Windows) may contain spaces. + let proj = config.ParentItem + yield! CompilerArguments.generateCompilerOptions (proj, projReferencedAssemblies, fsconfig, regLangVersion, CompilerArguments.getTargetFramework config.TargetFramework.Id, configSel, shouldWrap) ] + + + let private regParseFsOutput = Regex(@"(?[^\(]*)\((?[0-9]*),(?[0-9]*)\):\s(?[^:]*)\s(?[^:]*):\s(?.*)", RegexOptions.Compiled); + let private regParseFsOutputNoNum = Regex(@"(?[^\(]*)\((?[0-9]*),(?[0-9]*)\):\s(?[^:]*)\s(?.*)", RegexOptions.Compiled); + let private regParseFsOutputNoLocation = Regex(@"(?[^:]*)\s(?[^:]*):\s(?.*)", RegexOptions.Compiled); + + /// Process a single message emitted by the F# compiler + let processMsg msg = + let m = + let t1 = regParseFsOutput.Match(msg) + if t1.Success then t1 else + let t2 = regParseFsOutputNoNum.Match(msg) + if t2.Success then t2 else + regParseFsOutputNoLocation.Match(msg) + let get (s:string) = match m.Groups.Item(s) with null -> None | v -> match v.Value with null | "" -> None | x -> Some x + if m.Success then + let errNo = match get "err" with None -> "" | Some v -> v + let file = match get "file" with None -> "unknown-file" | Some v -> v + let line = match get "line" with None -> 1 | Some v -> int32 v + let col = match get "col" with None -> 1 | Some v -> int32 v + let msg = match get "msg" with None -> "" | Some v -> v + let isError = match get "type" with None -> true | Some v -> (v <> "warning") + isError, (file, line, col, errNo, msg) + else + true, ("unknown-file", 0, 0, "0", msg) + + (* + processMsg "warning FS0075: The command-line option '--warnon' is for internal use only" + = (false,("unknown-file", 1, 1, "FS0075","The command-line option '--warnon' is for internal use only")) + + processMsg @"C:\test\a.fs(2,17): warning FS0025: Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s)." + = (false,(@"C:\test\a.fs", 2, 17, "FS0025","Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s).")) + + processMsg @"C:\test space\a.fs(2,15): error FS0001: The type 'float' does not match the type 'int'" + = (true,(@"C:\test space\a.fs", 2, 15, "FS0001","The type 'float' does not match the type 'int'")) + + processMsg "error FS0082: Could not resolve this reference. Could not locate the assembly \"foo.dll\". Check to make sure the assembly exists on disk. If this reference is required by your code, you may get compilation errors. (Code=MSB3245)" + = (true,("unknown-file", 1, 1, "FS0082","Could not resolve this reference. Could not locate the assembly \"foo.dll\". Check to make sure the assembly exists on disk. If this reference is required by your code, you may get compilation errors. (Code=MSB3245)")) + *) + + /// Run the F# compiler with the specified arguments (passed as a list) + /// and print the arguments to progress monitor (Output in MonoDevelop) + let compile (runtime:TargetRuntime) (framework:TargetFramework) (monitor:ProgressMonitor) projectDir argsList = + + // let nw x = if x = None then "None" else x.Value + // monitor.Log.WriteLine("Env compiler: " + nw (Common.getCompilerFromEnvironment runtime framework)) + // monitor.Log.WriteLine("Override compiler: " + PropertyService.Get("FSharpBinding.FscPath")) + // monitor.Log.WriteLine("DefaultDefault compiler: " + (nw Common.getDefaultFSharpCompiler)) + // monitor.Log.WriteLine("Runtime: " + runtime.Id) + // monitor.Log.WriteLine("Framework: " + framework.Id.ToString()) + // monitor.Log.WriteLine("Default Runtime:" + IdeApp.Preferences.DefaultTargetRuntime.Id); + // monitor.Log.WriteLine("Default Framework:" + (Common.getDefaultTargetFramework IdeApp.Preferences.DefaultTargetRuntime).Id.ToString()) + + let br = BuildResult() + + // Concatenate arguments & run + let fscPath = + match CompilerArguments.getCompilerFromEnvironment runtime framework with + | Some(result) -> Some(result) + | None -> + match PropertyService.Get("FSharpBinding.FscPath","") with + | result when result <> "" -> + if runtime.Id <> IdeApp.Preferences.DefaultTargetRuntime.Value.Id then + br.AddWarning("No compiler found for the selected runtime; using default compiler instead.") |> ignore + Some(result) + | _ -> + match CompilerArguments.getDefaultFSharpCompiler() with + | Some(result) -> + if runtime.Id <> IdeApp.Preferences.DefaultTargetRuntime.Value.Id then + br.AddWarning("No compiler found for the selected runtime; using default compiler instead.") |> ignore + Some(result) + | None -> + br.AddError("No compiler found; add a default compiler in the F# settings.") |> ignore + None + + let args = String.concat "\n" argsList + + if fscPath = None then + br.FailedBuildCount <- 1 + br + else + monitor.Log.WriteLine("{0} {1}", fscPath.Value, args) + let args = String.concat " " argsList + let startInfo = + new ProcessStartInfo + (FileName = fscPath.Value, UseShellExecute = false, Arguments = args, + RedirectStandardError = true, CreateNoWindow = true, WorkingDirectory = projectDir) + LoggingService.LogDebug ("Compiler: Compile using: {0} Arguments: {1}", fscPath.Value, args) + let p = Process.Start(startInfo) + + LoggingService.LogDebug ("Compiler: Reading output..." ) + // Read all output and fold multi-line + let lines = + [ let line = ref "" + while (line := p.StandardError.ReadLine(); !line <> null) do + LoggingService.LogDebug ("Compiler: OUTPUT: {0}", !line) + yield !line + yield "" ] + let messages = + lines + |> Seq.fold (fun (current, all) line -> + if line = "" then [], (List.rev current)::all + else line::current, all) ([], []) + |> snd |> List.rev + |> List.map (String.concat " ") + |> List.filter (fun s -> s.Trim().Length > 0) + + // Parse messages and build results + for msg in messages do + match processMsg msg with + | true, (f, l, c, n, m) -> br.AddError(f, l, c, n, m) |> ignore + | false, (f, l, c, n, m) -> br.AddWarning(f, l, c, n, m) |> ignore + + + LoggingService.LogDebug ("Compiler: Waiting for exit...") + p.WaitForExit() + LoggingService.LogDebug ("Compiler: Done with compilation" ) + br.CompilerOutput <- String.concat "\n" lines + br + + // ------------------------------------------------------------------------------------ + /// Compiles the specified F# project using the current configuration + let Compile(items, config:DotNetProjectConfiguration, projReferencedAssemblies, configSel, monitor) : BuildResult = + let runtime = config.TargetRuntime + let framework = config.TargetFramework + let root = Path.GetDirectoryName(config.ParentItem.FileName.FullPath.ToString()) + let args = + [ yield! [ "--noframework --nologo" ] + yield! generateCmdArgs(config, projReferencedAssemblies, None, configSel) + yield! CompilerArguments.generateOtherItems items + + // Generate source files + let files = items + |> CompilerArguments.getSourceFiles + |> List.map CompilerArguments.wrapFile + yield! files ] + + compile runtime framework monitor root args + diff --git a/vsintegration/src/FSharp.Editor/Common/Extensions.fs b/vsintegration/src/FSharp.Editor/Common/Extensions.fs index 894ef61b23b..ccceaac719c 100644 --- a/vsintegration/src/FSharp.Editor/Common/Extensions.fs +++ b/vsintegration/src/FSharp.Editor/Common/Extensions.fs @@ -11,10 +11,21 @@ open Microsoft.CodeAnalysis.Host open FSharp.Compiler.Text open FSharp.Compiler.Ast open FSharp.Compiler.SourceCodeServices +open MonoDevelop.Core type private FSharpGlyph = FSharp.Compiler.SourceCodeServices.FSharpGlyph -type private FSharpRoslynGlyph = Microsoft.CodeAnalysis.ExternalAccess.FSharp.FSharpGlyph +//type private FSharpRoslynGlyph = Microsoft.CodeAnalysis.ExternalAccess.FSharp.FSharpGlyph +module LoggingService = + let inline private log f = Printf.kprintf f + + let inline private logWithThread f format = + log (log f "[UI - %b] %s" Runtime.IsMainThread) format + + let logDebug format = logWithThread LoggingService.LogDebug format + let logError format = logWithThread LoggingService.LogError format + let logInfo format = logWithThread LoggingService.LogInfo format + let logWarning format = logWithThread LoggingService.LogWarning format type Path with static member GetFullPathSafe path = @@ -130,10 +141,9 @@ module private SourceText = sourceText type SourceText with - member this.ToFSharpSourceText() = SourceText.weakTable.GetValue(this, Runtime.CompilerServices.ConditionalWeakTable<_,_>.CreateValueCallback(SourceText.create)) - +(* type FSharpNavigationDeclarationItem with member x.RoslynGlyph : FSharpRoslynGlyph = match x.Glyph with @@ -206,6 +216,7 @@ type FSharpNavigationDeclarationItem with | Some SynAccess.Internal -> FSharpRoslynGlyph.ExtensionMethodInternal | _ -> FSharpRoslynGlyph.ExtensionMethodPublic | FSharpGlyph.Error -> FSharpRoslynGlyph.Error +*) [] module String = @@ -239,6 +250,12 @@ module Option = else None + let inline tryCast<'T> (o: obj): 'T option = + match o with + | null -> None + | :? 'T as a -> Some a + | _ -> None + [] module Seq = open System.Collections.Immutable diff --git a/vsintegration/src/FSharp.Editor/Common/FSharpProject.fs b/vsintegration/src/FSharp.Editor/Common/FSharpProject.fs new file mode 100644 index 00000000000..5215c5ac1f1 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/FSharpProject.fs @@ -0,0 +1,294 @@ +namespace MonoDevelop.FSharp + +open System +open System.IO +open System.Threading.Tasks +open MonoDevelop.Core +open MonoDevelop.Core.Serialization +open MonoDevelop.Projects +open MonoDevelop.Projects.MSBuild +open MonoDevelop.Core.Assemblies + +open Microsoft.VisualStudio.FSharp.Editor.Pervasive +module Project = + let FSharp3Import = "$(MSBuildExtensionsPath32)\\..\\Microsoft SDKs\\F#\\3.0\\Framework\\v4.0\\Microsoft.FSharp.Targets" + let FSharpImport = @"$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets" + + let addConditionalTargets (msproject: MSBuildProject) = + let p = new MSBuildPropertyGroup() + p.SetValue("FSharpTargetsPath", FSharpImport, null, false, null) + msproject.AddPropertyGroup(p, true, null) + + let p = new MSBuildPropertyGroup() + p.Condition <- "'$(VisualStudioVersion)' == '10.0' OR '$(VisualStudioVersion)' == '11.0'" + p.SetValue("FSharpTargetsPath", FSharp3Import, null, false, null) + msproject.AddPropertyGroup(p, true, null) + +type FSharpProject() as self = + inherit DotNetProject() + do + self.RoslynLanguageName <- Microsoft.CodeAnalysis.LanguageNames.FSharp + self.SupportsRoslyn <- true + + // Keep the platforms combo of CodeGenerationPanelWidget in sync with this list + let supportedPlatforms = [| "anycpu"; "x86"; "x64"; "Itanium" |] + + let oldFSharpProjectGuid = "{4925A630-B079-445D-BCD4-3A9C94FE9307}" + let supportedPortableProfiles = ["Profile7";"Profile47";"Profile78";"Profile259"] + + ///keyed on TargetProfile, Value: TargetFSharpCoreVersion, netcore + let profileMap = + Map.ofList ["Profile7", ("3.3.1.0", true) + "Profile47", ("2.3.5.1", false) + "Profile78", ("3.78.3.1", true) + "Profile259", ("3.259.3.1", true) ] + + let mutable initialisedAsPortable = false + + let isPortable (project:MSBuildProject) = + project.EvaluatedProperties.Properties + |> Seq.tryFind (fun i -> i.UnevaluatedValue.Equals(".NETPortable")) + |> Option.isSome + + let directoryNameFromBuildItem (item:MSBuildItem) = + let itemInclude = item.Include.Replace('\\', Path.DirectorySeparatorChar) + Path.GetDirectoryName itemInclude + + let normalizePath (path:string) = + path.Replace(Path.DirectorySeparatorChar, '\\') + + let fixProjectFormatForVisualStudio (project:MSBuildProject) = + // Merge ItemGroups into one group ordered by folder name + // so that VS for Windows can load it. + let sharedAssetFiles = CompilerArguments.getSharedAssetFilesFromReferences self + let projectPath = project.FileName.ParentDirectory |> string + let projectFiles = + self.Files + |> Seq.filter(fun f -> f.BuildAction <> "Folder" && + f.BuildAction <> "Reference" && + not (sharedAssetFiles.Contains f.FilePath) && + f.Include <> null && + (not f.IsImported)) + |> Seq.mapi(fun i f -> i, f) + |> List.ofSeq + + let absolutePath path = MSBuildProjectService.FromMSBuildPath(projectPath, path) + + let itemGroupsContainingFilesCount = + project.ItemGroups + |> Seq.map(fun group -> + group.Items + |> Seq.filter(fun item -> + projectFiles |> List.exists(fun (_i,f) -> f.Include = item.Include))) + |> Seq.choose Seq.tryHead + |> Seq.length + + let allBuildItems = + project.GetAllItems() + |> Seq.filter(fun f -> f.Name <> "Folder" && + f.Name <> "Reference" && + f.Include <> null && + (not f.IsImported)) + |> Array.ofSeq + |> Array.sortBy(fun item -> + let res = + projectFiles + |> List.tryFind(fun(_i,f) -> f.Include = normalizePath item.Include) + match res with + | Some (i,_f) -> i + | None -> Int32.MaxValue) + + + let msbuildItems = + allBuildItems + |> Array.map (fun item -> item.Include, item) + + let msbuildItemsInProjectFiles = + msbuildItems + |> List.ofSeq + |> List.map snd + + let isParentDirectory folderName fileName = + if String.IsNullOrEmpty folderName then + true + else + let absoluteFolder = DirectoryInfo (absolutePath folderName) + let absoluteFile = FileInfo (absolutePath fileName) + let rec isParentDirRec (dir:DirectoryInfo) = + match dir with + | null -> false + | dir when dir.FullName = absoluteFolder.FullName -> true + | _ -> isParentDirRec dir.Parent + isParentDirRec absoluteFile.Directory + + let rec splitFilesByParent (items:MSBuildItem list) parentFolder list1 list2 = + match items with + | h :: t -> + if isParentDirectory parentFolder h.Include then + splitFilesByParent t parentFolder (h::list1) list2 + else + splitFilesByParent t parentFolder list1 (h::list2) + | [] -> (list1 |> List.rev) @ (list2 |> List.rev) + + let rec orderFiles items acc lastFolder = + match items with + | h :: t -> + let newFolder = directoryNameFromBuildItem h + if newFolder = lastFolder then + orderFiles t (h::acc) newFolder + else + let childrenFirst = (splitFilesByParent t newFolder [] []) + orderFiles childrenFirst (h::acc) newFolder + | [] -> acc |> List.rev + + let msbuildIncludes = + msbuildItemsInProjectFiles + |> List.map(fun item -> item.Name, normalizePath item.Include) + |> Set.ofList + + // Add any items that are projectFiles but not yet msbuild items to the unsorted list + // This is to fix a race condition that sometimes occurs - See #57689 + let buildItems = + projectFiles + |> List.filter(fun (_i, file) -> not (msbuildIncludes.Contains (file.BuildAction, normalizePath file.Include))) + |> List.fold(fun state (_i, file) -> + (new MSBuildItem(file.BuildAction, Include=file.Include)) :: state) msbuildItemsInProjectFiles + + let sortedItems = + orderFiles buildItems [] "" + |> List.distinctBy(fun i -> normalizePath i.Include) + + let getItemByInclude includePath = + allBuildItems |> Array.tryFind(fun item -> item.Include = includePath) + + let removeItemByInclude includePath = + getItemByInclude includePath + |> Option.iter(fun msbuildItem -> project.RemoveItem(msbuildItem, true)) + // Remove duplicate that differs only by path separator + getItemByInclude (normalizePath includePath) + |> Option.iter(fun msbuildItem -> project.RemoveItem(msbuildItem, true)) + + if itemGroupsContainingFilesCount > 1 || msbuildItemsInProjectFiles <> sortedItems then + let newGroup = project.AddNewItemGroup() + + for item in sortedItems do + removeItemByInclude item.Include + newGroup.AddItem item + + [] + member val TargetProfile = "mscorlib" with get, set + + [] + member val TargetFSharpCoreVersion = String.Empty with get, set + + [] + member val UseStandardResourceNames = true with get, set + + override x.IsPortableLibrary = initialisedAsPortable + + override x.OnReadProject(progress, project) = + initialisedAsPortable <- isPortable project + base.OnReadProject(progress, project) + + override x.OnReadProjectHeader(progress, project) = + initialisedAsPortable <- isPortable project + base.OnReadProjectHeader(progress, project) + + override x.OnSupportsFramework (framework) = + if isPortable self.MSBuildProject then + framework.Id.Identifier = TargetFrameworkMoniker.ID_PORTABLE && supportedPortableProfiles |> List.exists ((=) framework.Id.Profile) + else base.OnSupportsFramework (framework) + + override x.OnInitializeFromTemplate(createInfo, options) = + base.OnInitializeFromTemplate(createInfo, options) + if options.HasAttribute "FSharpPortable" then initialisedAsPortable <- true + if options.HasAttribute "TargetProfile" then x.TargetProfile <- options.GetAttribute "TargetProfile" + if options.HasAttribute "TargetFSharpCoreVersion" then x.TargetFSharpCoreVersion <- options.GetAttribute "TargetFSharpCoreVersion" + + override x.OnGetDefaultImports (imports) = + base.OnGetDefaultImports (imports) + + if initialisedAsPortable then + let fsharpPortableImport = + @"$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.Portable.FSharp.Targets" + imports.Add(fsharpPortableImport) + else + Project.addConditionalTargets base.MSBuildProject + imports.Add("$(FSharpTargetsPath)") + + override x.OnWriteProject(monitor, msproject) = + base.OnWriteProject(monitor, msproject) + fixProjectFormatForVisualStudio msproject + let globalGroup = msproject.GetGlobalPropertyGroup() + + maybe { + //Fix pcl netcore and TargetFSharpCoreVersion + let! targetFrameworkProfile = x.TargetFramework.Id.Profile |> Option.ofObj + let! fsharpcoreversion, netcore = profileMap |> Map.tryFind targetFrameworkProfile + do globalGroup.SetValue ("TargetFSharpCoreVersion", fsharpcoreversion, "", true) + let targetProfile = if netcore then "netcore" else "mscorlib" + do globalGroup.SetValue ("TargetProfile", targetProfile, "mscorlib", true) } |> ignore + + // This removes the old guid on saving the project + let removeGuid (innerText:string) guidToRemove = + innerText.Split ( [|';'|], StringSplitOptions.RemoveEmptyEntries) + |> Array.filter (fun guid -> not (guid.Equals (guidToRemove, StringComparison.OrdinalIgnoreCase))) + |> String.concat ";" + + try + let fsimportExists = + msproject.Imports + |> Seq.exists (fun import -> import.Project.EndsWith("FSharp.Targets", StringComparison.OrdinalIgnoreCase)) + if fsimportExists then + globalGroup.GetProperties() + |> Seq.tryFind (fun p -> p.Name = "ProjectTypeGuids") + |> Option.iter (fun currentGuids -> let newProjectTypeGuids = removeGuid currentGuids.Value oldFSharpProjectGuid + currentGuids.SetValue(newProjectTypeGuids)) + with exn -> LoggingService.LogWarning("Failed to remove old F# guid", exn) + + [] + override x.OnCompileSources(items, config, configSel, monitor) = + let asms = (x.GetReferences configSel).Result + CompilerService.Compile(items, config, asms, configSel, monitor) + + override x.OnCreateCompilationParameters(config, kind) = + let pars = new FSharpCompilerParameters() + config.CompilationParameters <- pars + + // Set up the default options + if supportedPlatforms |> Array.exists (fun x -> x.Contains(config.Platform)) then pars.PlatformTarget <- config.Platform + match kind with + | ConfigurationKind.Debug -> + pars.AddDefineSymbol "DEBUG" + pars.Optimize <- false + pars.GenerateTailCalls <- false + | ConfigurationKind.Release -> + pars.Optimize <- true + pars.GenerateTailCalls <- true + | _ -> () + //pars.DocumentationFile <- config.CompiledOutputName.FileNameWithoutExtension + ".xml" + pars :> DotNetCompilerParameters + + override x.OnGetSupportedClrVersions() = + [| ClrVersion.Net_2_0; ClrVersion.Net_4_0; ClrVersion.Net_4_5; ClrVersion.Clr_2_1 |] + + override x.OnGetDefaultResourceId(projectFile) = + projectFile.FilePath.FileName + + member x.GetOrderedReferences(config:ConfigurationSelector) = + async { + let orderAssemblyReferences = MonoDevelop.FSharp.OrderAssemblyReferences() + let! asms = x.GetReferences config |> Async.AwaitTask + let references = + CompilerArguments.getReferencesFromProject (x, config, asms) + |> Seq.choose (fun ref -> if (ref.Contains "mscorlib.dll" || ref.Contains "FSharp.Core.dll") + then None + else + let ref = ref.Replace ("-r:", "") + if File.Exists ref then Some ref + else None ) + |> Seq.distinct + |> Seq.toArray + return orderAssemblyReferences.Order references + } + diff --git a/vsintegration/src/FSharp.Editor/Common/FileService.fs b/vsintegration/src/FSharp.Editor/Common/FileService.fs new file mode 100644 index 00000000000..db80e1af359 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/FileService.fs @@ -0,0 +1,36 @@ +namespace MonoDevelop.FSharp +open FSharp.Compiler.AbstractIL.Internal.Library +open System.IO +open MonoDevelop.Ide +open MonoDevelop.Ide.Gui +open MonoDevelop.Core +type Version = int + +type FileSystem (defaultFileSystem : IFileSystem, openDocuments: unit -> Document seq) = + static member IsAScript fileName = + let ext = Path.GetExtension fileName + [".fsx";".fsscript";".sketchfs"] |> List.exists ((=) ext) + +module FileService = + let supportedFileExtensions = + set [".fsscript"; ".fs"; ".fsx"; ".fsi"; ".sketchfs"] + + /// Is the specified extension supported F# file? + let supportedFileName fileName = + if fileName = null then + false + else + let ext = Path.GetExtension(fileName).ToLower() + supportedFileExtensions + |> Set.contains ext + + let isInsideFSharpFile () = + if IdeApp.Workbench.ActiveDocument = null || + IdeApp.Workbench.ActiveDocument.FileName.FileName = null then false + else + let file = IdeApp.Workbench.ActiveDocument.FileName.ToString() + supportedFileName (file) + + let supportedFilePath (filePath:FilePath) = + supportedFileName (string filePath) + diff --git a/vsintegration/src/FSharp.Editor/Common/LanguageService.fs b/vsintegration/src/FSharp.Editor/Common/LanguageService.fs new file mode 100644 index 00000000000..bca0d71fc29 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/LanguageService.fs @@ -0,0 +1,158 @@ +namespace MonoDevelop.FSharp +open System +open System.Collections.Generic +open System.IO +open FSharp.Compiler +open FSharp.Compiler.SourceCodeServices +open MonoDevelop.FSharp +open MonoDevelop.Core +open MonoDevelop.Ide +open MonoDevelop.Projects +open Microsoft.VisualStudio.FSharp.Editor.Extensions + +module Symbol = + /// We always know the text of the identifier that resolved to symbol. + /// Trim the range of the referring text to only include this identifier. + /// This means references like A.B.C are trimmed to "C". This allows renaming to just rename "C". + let trimSymbolRegion(symbolUse:FSharpSymbolUse) (lastIdentAtLoc:string) = + let m = symbolUse.RangeAlternate + let ((beginLine, beginCol), (endLine, endCol)) = ((m.StartLine, m.StartColumn), (m.EndLine, m.EndColumn)) + + let (beginLine, beginCol) = + if endCol >=lastIdentAtLoc.Length && (beginLine <> endLine || (endCol-beginCol) >= lastIdentAtLoc.Length) then + (endLine,endCol-lastIdentAtLoc.Length) + else + (beginLine, beginCol) + Range.mkPos beginLine beginCol, Range.mkPos endLine endCol + +/// Contains settings of the F# language service +module ServiceSettings = + let internal getEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt + /// When making blocking calls from the GUI, we specify this value as the timeout, so that the GUI is not blocked forever + let blockingTimeout = getEnvInteger "FSharpBinding_BlockingTimeout" 1000 + let maximumTimeout = getEnvInteger "FSharpBinding_MaxTimeout" 10000 + let idleBackgroundCheckTime = getEnvInteger "FSharpBinding_IdleBackgroundCheckTime" 2000 + +[] +type AllowStaleResults = + // Allow checker results where the source doesn't even match + | MatchingFileName + // Allow checker results where the source matches but where the background builder may not have caught up yet after some other change + | MatchingSource + +//type Debug = System.Console +open Microsoft.VisualStudio.FSharp.Editor.Pervasive + +/// Provides functionality for working with the F# interactive checker running in background +type LanguageService(checker: FSharpChecker, dirtyNotify, _extraProjectInfo) as x = + + /// Load times used to reset type checking properly on script/project load/unload. It just has to be unique for each project load/reload. + /// Not yet sure if this works for scripts. + let fakeDateTimeRepresentingTimeLoaded proj = DateTime(abs (int64 (match proj with null -> 0 | _ -> proj.GetHashCode())) % 103231L) + let checkProjectResultsCache = Collections.Generic.Dictionary() + + + let loadingProjects = HashSet() + + let showStatusIcon projectFileName = + if loadingProjects.Add projectFileName then + IdeApp.TypeSystemService.BeginWorkspaceLoad() + + let hideStatusIcon projectFileName = + if loadingProjects.Remove projectFileName then + IdeApp.TypeSystemService.EndWorkspaceLoad() + + /// When creating new script file on Mac, the filename we get sometimes + /// has a name //foo.fsx, and as a result 'Path.GetFullPath' throws in the F# + /// language service - this fixes the issue by inventing nicer file name. + let fixFileName path = + if (try Path.GetFullPath(path) |> ignore; true + with _ -> false) then path + else + let dir = + if Environment.OSVersion.Platform = PlatformID.Unix || + Environment.OSVersion.Platform = PlatformID.MacOSX then + Environment.GetEnvironmentVariable("HOME") + else + Environment.ExpandEnvironmentVariables("%HOMEDRIVE%%HOMEPATH%") + Path.Combine(dir, Path.GetFileName(path)) + + let optionsForDependentProject projectFile = + let project = x.GetProjectFromFileName projectFile + async { + let! assemblies = async { + match project with + | Some (proj:DotNetProject) -> return! proj.GetReferences(CompilerArguments.getConfig()) |> Async.AwaitTask + | None -> return new List () + } + return x.GetProjectCheckerOptions(projectFile, [], assemblies) + } + + member x.HideStatusIcon = hideStatusIcon + + member x.GetProjectFromFileName projectFile = + IdeApp.Workspace.GetAllProjects() + |> Seq.tryFind (fun p -> p.FileName.FullPath.ToString() = projectFile) + |> Option.map(fun p -> p :?> DotNetProject) + + member x.GetProjectOptionsFromProjectFile (project:DotNetProject) (config:ConfigurationSelector) (referencedAssemblies:AssemblyReference seq) = + + // hack: we can't just pull the refs out of referencedAssemblies as we use this for referenced projects as well + let getReferencedFSharpProjects (project:DotNetProject) = + project.GetReferencedAssemblyProjects config + |> Seq.filter (fun p -> p <> project && p.SupportedLanguages |> Array.contains "F#") + + let rec getOptions referencedProject = + // hack: we use the referencedAssemblies of the root project for the dependencies' options as well + // which is obviously wrong, but it doesn't seem to matter in this case + let projectOptions = CompilerArguments.getArgumentsFromProject referencedProject config referencedAssemblies + //match projectOptions with + //| Some projOptions -> + let referencedProjectOptions = + referencedProject + |> getReferencedFSharpProjects + |> Seq.fold (fun acc reference -> + match getOptions reference with + | Some outFile, Some opts -> (outFile, opts) :: acc + | _ -> acc) ([]) + + (Some (referencedProject.GetOutputFileName(config).ToString()), Some ({ projectOptions with ReferencedProjects = referencedProjectOptions |> Array.ofList } )) + //| None -> None, None + let _file, projectOptions = getOptions project + projectOptions + + /// Constructs options for the interactive checker for a project under the given configuration. + member x.GetProjectCheckerOptions(projFilename, ?properties, ?referencedAssemblies) : FSharpProjectOptions option = + let config = + maybe { + let! ws = IdeApp.Workspace |> Option.ofObj + return! ws.ActiveConfiguration |> Option.ofObj + } |> Option.defaultValue ConfigurationSelector.Default + let configId = + match IdeApp.Workspace with + | null -> null + | ws -> ws.ActiveConfigurationId + let properties = defaultArg properties ["Configuration", configId] + showStatusIcon projFilename + + checker.ProjectChecked.Add (fun (filename, _) -> + hideStatusIcon filename) + + let project = + IdeApp.Workspace.GetAllProjects() + |> Seq.tryFind (fun p -> p.FileName.FullPath.ToString() = projFilename) + + match project with + | Some proj -> + let proj = proj :?> DotNetProject + //fixme eliminate this .Result + let asms = match referencedAssemblies with + | Some a -> a + | None -> (proj.GetReferences config).Result + let opts = x.GetProjectOptionsFromProjectFile proj config asms + opts |> Option.bind(fun opts' -> + // Print contents of check option for debugging purposes + LoggingService.logDebug "GetProjectCheckerOptions: ProjectFileName: %s, ProjectFileNames: %A, ProjectOptions: %A, IsIncompleteTypeCheckEnvironment: %A, UseScriptResolutionRules: %A" + opts'.ProjectFileName opts'.SourceFiles opts'.OtherOptions opts'.IsIncompleteTypeCheckEnvironment opts'.UseScriptResolutionRules + opts) + | None -> None diff --git a/vsintegration/src/FSharp.Editor/Common/Logging.fs b/vsintegration/src/FSharp.Editor/Common/Logging.fs index cc37f948f42..6a754a304ef 100644 --- a/vsintegration/src/FSharp.Editor/Common/Logging.fs +++ b/vsintegration/src/FSharp.Editor/Common/Logging.fs @@ -1,11 +1,8 @@ namespace Microsoft.VisualStudio.FSharp.Editor.Logging open System -open System.Diagnostics -open System.ComponentModel.Composition -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.FSharp.Editor +open MonoDevelop.Core [] type LogType = @@ -20,71 +17,17 @@ type LogType = | Warn -> "Warning" | Error -> "Error" - -module Config = - let [] fsharpOutputGuidString = "E721F849-446C-458C-997A-99E14A04CFD3" - let fsharpOutputGuid = Guid fsharpOutputGuidString - -open Config - -type [] Logger [] - ([)>] serviceProvider: IServiceProvider) = - let outputWindow = serviceProvider.GetService() |> Option.ofObj - - let createPane () = - outputWindow |> Option.iter (fun x -> - x.CreatePane(ref fsharpOutputGuid,"F# Language Service", Convert.ToInt32 true, Convert.ToInt32 false) |> ignore) - - do createPane () - - let getPane () = - match outputWindow |> Option.map (fun x -> x.GetPane (ref fsharpOutputGuid)) with - | Some (0, pane) -> - pane.Activate() |> ignore - Some pane - | _ -> None - - static let mutable globalServiceProvider: IServiceProvider option = None - - static member GlobalServiceProvider - with get () = globalServiceProvider |> Option.defaultValue (ServiceProvider.GlobalProvider :> IServiceProvider) - and set v = globalServiceProvider <- Some v - - member __.FSharpLoggingPane - with get () = - getPane () - |> function - | Some pane -> Some pane - | None -> - createPane() - getPane() - - member self.Log (msgType:LogType,msg:string) = - let time = DateTime.Now.ToString("hh:mm:ss tt") - match self.FSharpLoggingPane, msgType with - | None, _ -> () - | Some pane, LogType.Message -> String.Format("[F#][{0}{1}] {2}{3}", "" , time, msg, Environment.NewLine) |> pane.OutputString |> ignore - | Some pane, LogType.Info -> String.Format("[F#][{0}{1}] {2}{3}", "INFO " , time, msg, Environment.NewLine) |> pane.OutputString |> ignore - | Some pane, LogType.Warn -> String.Format("[F#][{0}{1}] {2}{3}", "WARN " , time, msg, Environment.NewLine) |> pane.OutputString |> ignore - | Some pane, LogType.Error -> String.Format("[F#][{0}{1}] {2}{3}", "ERROR ", time, msg, Environment.NewLine) |> pane.OutputString |> ignore - [] module Logging = + let inline private log f = Printf.kprintf f - let inline debug msg = Printf.kprintf Debug.WriteLine msg - - let private logger = lazy Logger(Logger.GlobalServiceProvider) - let private log logType msg = logger.Value.Log(logType,msg) - - let logMsg msg = log LogType.Message msg - let logInfo msg = log LogType.Info msg - let logWarning msg = log LogType.Warn msg - let logError msg = log LogType.Error msg + let inline private logWithThread f format = + log (log f "[UI - %b] %s" Runtime.IsMainThread) format - let logMsgf msg = Printf.kprintf (log LogType.Message) msg - let logInfof msg = Printf.kprintf (log LogType.Info) msg - let logWarningf msg = Printf.kprintf (log LogType.Warn) msg - let logErrorf msg = Printf.kprintf (log LogType.Error) msg + let logDebug format = logWithThread LoggingService.LogDebug format + let logErrorf format = logWithThread LoggingService.LogError format + let logInfof format = logWithThread LoggingService.LogInfo format + let logWarning format = logWithThread LoggingService.LogWarning format let logException (ex: Exception) = logErrorf "Exception Message: %s\nStack Trace: %s" ex.Message ex.StackTrace diff --git a/vsintegration/src/FSharp.Editor/Common/OrderAssemblyReferences.fs b/vsintegration/src/FSharp.Editor/Common/OrderAssemblyReferences.fs new file mode 100644 index 00000000000..c8001a124c6 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/OrderAssemblyReferences.fs @@ -0,0 +1,113 @@ +namespace MonoDevelop.FSharp + +open System +open Mono.Cecil + +module Object = + let eqHack (f: 'a -> 'b) (x: 'a) (yobj: Object) : Boolean = + match yobj with + | :? 'a as y -> f x = f y + | _ -> false + + let compHack (f: 'a -> 'b) (x: 'a) (yobj: Object) : Int32 = + match yobj with + | :? 'a as y -> compare (f x) (f y) + | _ -> invalidArg "yobj" "Cannot compare elements of incompatible types" + +type Digraph<'n> when 'n : comparison = + Map<'n, Set<'n>> + +module Digraph = + + let addNode (n: 'n) (g: Digraph<'n>) : Digraph<'n> = + match Map.tryFind n g with + | None -> Map.add n Set.empty g + | Some _ -> g + + let addEdge ((n1, n2): 'n * 'n) (g: Digraph<'n>) : Digraph<'n> = + let g' = + match Map.tryFind n2 g with + | None -> addNode n2 g + | Some _ -> g + match Map.tryFind n1 g with + | None -> Map.add n1 (Set.singleton n2) g' + | Some ns -> Map.add n1 (Set.add n2 ns) g' + + let nodes (g: Digraph<'n>) : List<'n> = + Map.fold (fun xs k _ -> k::xs) [] g + + let roots (g: Digraph<'n>) : List<'n> = + List.filter (fun n -> not (Map.exists (fun _ v -> Set.contains n v) g)) (nodes g) + + let topSort (h: Digraph<'n>) : List<'n> = + let rec dfs (g: Digraph<'n>, order: List<'n>, rts: List<'n>) : List<'n> = + if List.isEmpty rts then + order + else + let n = List.head rts + let order' = n::order + let g' = Map.remove n g + let rts' = roots g' + dfs (g', order', rts') + dfs (h, [], roots h) + +[] +[] +[] +type AssemblyRef = + { + Path: String + Assembly: AssemblyDefinition + Name: String + } + + member this.show = this.ToString () + + override this.Equals (obj: Object) : bool = + Object.eqHack (fun (a:AssemblyRef) -> a.Name) this obj + + override this.GetHashCode () = + hash this.Name + + interface System.IComparable with + member this.CompareTo (obj: Object) = + Object.compHack (fun (p:AssemblyRef) -> p.Name) this obj + + override x.ToString () = x.Path + +[] +type OrderAssemblyReferences () = + + let mkGraph (seeds: seq) : Digraph = + + let findRef (s: seq) (m: AssemblyNameReference) = + match Seq.tryFind (fun r -> r.Name = m.FullName) seeds with + | None -> s + | Some ar -> Seq.append (Seq.singleton ar) s + + let processNode (g: Digraph) (n: AssemblyRef) = + let depNames = n.Assembly.MainModule.AssemblyReferences.ToArray() + let depRefs = Array.fold findRef Seq.empty depNames + Seq.fold (fun h c -> Digraph.addEdge (n, c) h) g depRefs + + let rec fixpoint (g: Digraph) = + let ns = Digraph.nodes g + let g' = List.fold processNode g ns + if g = g' then g else fixpoint g' + + fixpoint (Seq.fold (fun g s -> Digraph.addNode s g) Map.empty seeds) + + let mkAssemblyRef (t: String) = + let assemblyDefinition = Mono.Cecil.AssemblyDefinition.ReadAssembly(t) + { + Path = t + Assembly = assemblyDefinition + Name = assemblyDefinition.FullName + } + + ///Orders the passed in array of assembly references in dependency order + member x.Order(rs: String[]) = + let asmRefs = Array.map mkAssemblyRef rs + let graph = mkGraph asmRefs + let ordering = Digraph.topSort graph + ordering diff --git a/vsintegration/src/FSharp.Editor/Common/Parameters.fs b/vsintegration/src/FSharp.Editor/Common/Parameters.fs new file mode 100644 index 00000000000..1204cb8fa9d --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/Parameters.fs @@ -0,0 +1,93 @@ +// -------------------------------------------------------------------------------------- +// Serializable types that store F# project parameters (build order) and +// F# compiler parameters (debug mode, tail-calls, etc.) +// -------------------------------------------------------------------------------------- + +namespace MonoDevelop.FSharp + +open System +open MonoDevelop.Core.Serialization +open MonoDevelop.Projects + +/// Serializable type respresnting F# compiler parameters +type FSharpCompilerParameters() = + inherit MonoDevelop.Projects.DotNetCompilerParameters() + + [] + let mutable optimize = true + + [] + let mutable generateTailCalls = false + + [] + let mutable noStdLib = false + + [] + let mutable defineConstants = "" + + [] + let mutable otherFlags = "" + + [] + let mutable documentationFile = "" + + [] + let mutable platformTarget = "anycpu" + + [] + let mutable warnAsError = false + + [] + let mutable warningLevel = 4 + + [] + let mutable nowarn = String.Empty + + [] + let mutable debugType = "portable" + + let getPlatformTarget() = + match platformTarget with + | "AnyCPU" -> "anycpu" // AnyCPU isn't a valid platform for the F# compiler + | target -> target + + member x.Optimize with get () = optimize and set v = optimize <- v + member x.GenerateTailCalls with get () = generateTailCalls and set v = generateTailCalls <- v + override x.NoStdLib with get () = noStdLib and set v = noStdLib <- v + member x.DefineConstants with get () = defineConstants and set v = defineConstants <- v + member x.OtherFlags with get () = otherFlags and set v = otherFlags <- v + member x.DocumentationFile with get () = documentationFile and set v = documentationFile <- v + member x.PlatformTarget with get () = getPlatformTarget() and set v = platformTarget <- v + member x.TreatWarningsAsErrors with get () = warnAsError and set v = warnAsError <- v + member x.WarningLevel with get () = warningLevel and set v = warningLevel <- v + member x.NoWarn with get () = nowarn and set v = nowarn <- v + member x.DebugType with get () = debugType and set v = debugType <- v + + override x.AddDefineSymbol(symbol) = + if System.String.IsNullOrEmpty x.DefineConstants then + x.DefineConstants <- symbol + else + x.DefineConstants <- x.DefineConstants + ";" + symbol + + override x.RemoveDefineSymbol(symbol) = + if x.DefineConstants = symbol then + x.DefineConstants <- "" + elif (String.IsNullOrWhiteSpace >> not) x.DefineConstants then + x.DefineConstants <- x.DefineConstants.Replace(";" + symbol, "") + + override x.GetDefineSymbols () = + if String.IsNullOrWhiteSpace x.DefineConstants then + Seq.empty + else + x.DefineConstants.Split (';', ',', ' ', '\t') + |> Seq.where (String.IsNullOrWhiteSpace >> not) + + override x.CreateCompilationOptions () = + null //TODO + + override x.CreateParseOptions (_) = + null //TODO + + override x.Write pset = + pset.SetPropertyOrder ("DebugSymbols", "DebugType", "Optimize", "OutputPath", "DefineConstants", "ErrorReport", "WarningLevel", "TreatWarningsAsErrors", "DocumentationFile"); + base.Write pset diff --git a/vsintegration/src/FSharp.Editor/Common/Pervasive.fs b/vsintegration/src/FSharp.Editor/Common/Pervasive.fs index 9dd525d609c..2732b083866 100644 --- a/vsintegration/src/FSharp.Editor/Common/Pervasive.fs +++ b/vsintegration/src/FSharp.Editor/Common/Pervasive.fs @@ -4,14 +4,15 @@ module Microsoft.VisualStudio.FSharp.Editor.Pervasive open System open System.IO open System.Diagnostics +open System.Threading.Tasks /// Checks if the filePath ends with ".fsi" -let isSignatureFile (filePath:string) = +let isSignatureFile (filePath:string) = String.Equals (Path.GetExtension filePath, ".fsi", StringComparison.OrdinalIgnoreCase) /// Checks if the file paht ends with '.fsx' or '.fsscript' -let isScriptFile (filePath:string) = - let ext = Path.GetExtension filePath +let isScriptFile (filePath:string) = + let ext = Path.GetExtension filePath String.Equals (ext, ".fsx", StringComparison.OrdinalIgnoreCase) || String.Equals (ext, ".fsscript", StringComparison.OrdinalIgnoreCase) type internal ISetThemeColors = abstract member SetColors: unit -> unit @@ -168,7 +169,7 @@ let asyncMaybe = AsyncMaybeBuilder() let inline liftAsync (computation : Async<'T>) : Async<'T option> = async { let! a = computation - return Some a + return Some a } let liftTaskAsync task = task |> Async.AwaitTask |> liftAsync @@ -180,7 +181,7 @@ module Async = return f a } - /// Creates an asynchronous workflow that runs the asynchronous workflow given as an argument at most once. + /// Creates an asynchronous workflow that runs the asynchronous workflow given as an argument at most once. /// When the returned workflow is started for the second time, it reuses the result of the previous execution. let cache (input : Async<'T>) = let agent = MailboxProcessor>.Start <| fun agent -> @@ -190,6 +191,18 @@ module Async = replyCh.Reply res while true do let! replyCh = agent.Receive () - replyCh.Reply res + replyCh.Reply res } - async { return! agent.PostAndAsyncReply id } \ No newline at end of file + async { return! agent.PostAndAsyncReply id } + + let inline awaitPlainTask (task: Task) = + task.ContinueWith (fun task -> if task.IsFaulted then raise task.Exception) + |> Async.AwaitTask + +[] +module AsyncTaskBind = + type Microsoft.FSharp.Control.AsyncBuilder with + member x.Bind(computation:Task<'T>, binder:'T -> Async<'R>) = x.Bind(Async.AwaitTask computation, binder) + member x.ReturnFrom(computation:Task<'T>) = x.ReturnFrom(Async.AwaitTask computation) + member x.Bind(computation:Task, binder:unit -> Async) = x.Bind(Async.awaitPlainTask computation, binder) + member x.ReturnFrom(computation:Task) = x.ReturnFrom(Async.awaitPlainTask computation) diff --git a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs index ae8c5fe4fb6..1871354ba59 100644 --- a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs @@ -18,7 +18,7 @@ open Microsoft.VisualStudio.FSharp.Editor.Logging open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Diagnostics [] -module internal RoslynHelpers = +module RoslynHelpers = let FSharpRangeToTextSpan(sourceText: SourceText, range: range) = // Roslyn TextLineCollection is zero-based, F# range lines are one-based @@ -117,6 +117,7 @@ module internal RoslynHelpers = tcs.TrySetCanceled(cancellationToken) |> ignore | exn -> System.Diagnostics.Trace.WriteLine("Visual F# Tools: exception swallowed and not passed to Roslyn: {0}", exn.Message) + System.Diagnostics.Trace.WriteLine(exn.StackTrace) let res = Unchecked.defaultof<_> tcs.TrySetResult(res) |> ignore ), diff --git a/vsintegration/src/FSharp.Editor/Completion/AsyncCompletionCommitManager.fs b/vsintegration/src/FSharp.Editor/Completion/AsyncCompletionCommitManager.fs new file mode 100644 index 00000000000..735ed7839d7 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Completion/AsyncCompletionCommitManager.fs @@ -0,0 +1,71 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion +open Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data + +type FSharpAsyncCompletionCommitManager() = + interface IAsyncCompletionCommitManager with + + /// + /// + /// Returns characters that may commit completion. + /// + /// + /// When completion is active and a text edit matches one of these characters, + /// is called to verify that the character + /// is indeed a commit character at a given location. + /// + /// + /// Called on UI thread. + /// + /// + override __.PotentialCommitCharacters = [' '; '='; ','; '.'; '<'; '>'; '('; ')'; '!'; ':'; '['; ']'; '|'] |> Seq.ofList + + /// + /// + /// Returns whether is a commit character at a given . + /// + /// + /// If in your language every character returned by + /// is a commit character, simply return . + /// + /// + /// Called on UI thread. + /// + /// + /// The active + /// Location in the snapshot of the view's topmost buffer. The character is not inserted into this snapshot + /// Character typed by the user + /// Token used to cancel this operation + /// True if this character should commit the active session + override __.ShouldCommitCompletion(session, location, typedChar, token) = true + + /// + /// + /// Allows the implementer of to customize how specified is committed. + /// This method is called on UI thread, before the is inserted into the buffer. + /// + /// + /// In most cases, implementer does not need to commit the item. Return to allow another + /// to attempt the commit, or to invoke the default commit behavior. + /// + /// + /// To perform a custom commit, replace contents of + /// at a location indicated by + /// with text stored in . + /// To move the caret, use . + /// Finally, return . Use to influence Editor's behavior + /// after invoking this method. + /// + /// + /// Called on UI thread. + /// + /// + /// The active . See and + /// Subject buffer which matches this 's content type + /// Which is to be committed + /// Text change associated with this commit + /// Token used to cancel this operation + /// Instruction for the editor how to proceed after invoking this method. Default is + override __.TryCommit(session, buffer, item, typedChar, token) = CommitResult.Unhandled diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 9ec89f069dd..2459a9b22d6 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -10,22 +10,18 @@ open System.Threading.Tasks open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Completion -open Microsoft.CodeAnalysis.Options open Microsoft.CodeAnalysis.Text -open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Completion - -open Microsoft.VisualStudio.Shell open FSharp.Compiler open FSharp.Compiler.Range open FSharp.Compiler.SourceCodeServices - +open Microsoft.VisualStudio.Text.Adornments +open Microsoft.VisualStudio.Text.Editor module Logger = Microsoft.VisualStudio.FSharp.Editor.Logger type internal FSharpCompletionProvider ( workspace: Workspace, - serviceProvider: SVsServiceProvider, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, assemblyContentProvider: AssemblyContentProvider @@ -48,17 +44,13 @@ type internal FSharpCompletionProvider Keywords.KeywordsWithDescription |> List.filter (fun (keyword, _) -> not (PrettyNaming.IsOperatorName keyword)) |> List.sortBy (fun (keyword, _) -> keyword) - |> List.mapi (fun n (keyword, description) -> - FSharpCommonCompletionItem.Create(keyword, null, CompletionItemRules.Default, Nullable Glyph.Keyword, sortText = sprintf "%06d" (1000000 + n)) - .AddProperty("description", description) - .AddProperty(IsKeywordPropName, "")) + let checker = checkerProvider.Checker - + let settings: EditorOptions = workspace.Services.GetService() - let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder(serviceProvider.XMLMemberIndexService) - + let documentationBuilder = XmlDocumentation.Provider() static let noCommitOnSpaceRules = // These are important. They make sure we don't _commit_ autocompletion when people don't expect them to. Some examples: // @@ -80,16 +72,16 @@ type internal FSharpCompletionProvider static let mruItems = Dictionary<(* Item.FullName *) string, (* hints *) int>() - static member ShouldTriggerCompletionAux(sourceText: SourceText, caretPosition: int, trigger: CompletionTriggerKind, getInfo: (unit -> DocumentId * string * string list), intelliSenseOptions: IntelliSenseOptions) = + static member ShouldTriggerCompletionAux(sourceText: SourceText, caretPosition: int, trigger: Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionTrigger, getInfo: (unit -> DocumentId * string * string list), intelliSenseOptions: IntelliSenseOptions) = if caretPosition = 0 then false else let triggerPosition = caretPosition - 1 - let triggerChar = sourceText.[triggerPosition] + let triggerChar = trigger.Character - if trigger = CompletionTriggerKind.Deletion && intelliSenseOptions.ShowAfterCharIsDeleted then - Char.IsLetterOrDigit(sourceText.[triggerPosition]) || triggerChar = '.' - elif not (trigger = CompletionTriggerKind.Insertion) then + if trigger.Reason = Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionTriggerReason.Deletion && intelliSenseOptions.ShowAfterCharIsDeleted then + Char.IsLetterOrDigit(triggerChar) || triggerChar = '.' + elif not (trigger.Reason = Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionTriggerReason.Insertion || trigger.Reason = Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionTriggerReason.InvokeAndCommitIfUnique) then false else // Do not trigger completion if it's not single dot, i.e. range expression @@ -98,10 +90,10 @@ type internal FSharpCompletionProvider else let documentId, filePath, defines = getInfo() CompletionUtils.shouldProvideCompletion(documentId, filePath, defines, sourceText, triggerPosition) && - (triggerChar = '.' || (intelliSenseOptions.ShowAfterCharIsTyped && CompletionUtils.isStartingNewWord(sourceText, triggerPosition))) + (trigger.Reason = Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionTriggerReason.InvokeAndCommitIfUnique || triggerChar = '.' || (intelliSenseOptions.ShowAfterCharIsTyped && CompletionUtils.isStartingNewWord(sourceText, triggerPosition))) - static member ProvideCompletionsAsyncAux(checker: FSharpChecker, sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, filePath: string, + static member ProvideCompletionsAsyncAux(completionSource: Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.IAsyncCompletionSource , checker: FSharpChecker, sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, filePath: string, textVersionHash: int, getAllSymbols: FSharpCheckFileResults -> AssemblySymbol list, languageServicePerformanceOptions: LanguageServicePerformanceOptions, intellisenseOptions: IntelliSenseOptions) = asyncMaybe { let! parseResults, _, checkFileResults = checker.ParseAndCheckDocument(filePath, textVersionHash, sourceText, options, languageServicePerformanceOptions, userOpName = userOpName) @@ -120,7 +112,7 @@ type internal FSharpCompletionProvider let! declarations = checkFileResults.GetDeclarationListInfo(Some(parseResults), fcsCaretLineNumber, caretLine.ToString(), partialName, getAllSymbols, userOpName=userOpName) |> liftAsync - let results = List() + let results = List() declarationItems <- declarations.Items @@ -139,6 +131,7 @@ type internal FSharpCompletionProvider declarationItems |> Array.iteri (fun number declarationItem -> let glyph = Tokenizer.FSharpGlyphToRoslynGlyph (declarationItem.Glyph, declarationItem.Accessibility) + let image = GlyphHelper.getImageId glyph |> ImageElement let name = match declarationItem.NamespaceToOpen with | Some namespaceToOpen -> sprintf "%s (open %s)" declarationItem.Name namespaceToOpen @@ -152,27 +145,28 @@ type internal FSharpCompletionProvider // We are passing last part of long ident as FilterText. | _, idents -> Array.last idents - let completionItem = - FSharpCommonCompletionItem.Create(name, null, rules = getRules intellisenseOptions.ShowAfterCharIsTyped, glyph = Nullable glyph, filterText = filterText) - .AddProperty(FullNamePropName, declarationItem.FullName) - + let completionItem = + let item = new Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionItem(name, completionSource, icon = image) + item.Properties.AddProperty(IndexPropName, declarationItem) + item + let completionItem = match declarationItem.Kind with | CompletionItemKind.Method (isExtension = true) -> - completionItem.AddProperty(IsExtensionMemberPropName, "") + completionItem//.AddProperty(IsExtensionMemberPropName, "") | _ -> completionItem let completionItem = if name <> declarationItem.NameInCode then - completionItem.AddProperty(NameInCodePropName, declarationItem.NameInCode) + completionItem//.AddProperty(NameInCodePropName, declarationItem.NameInCode) else completionItem let completionItem = match declarationItem.NamespaceToOpen with - | Some ns -> completionItem.AddProperty(NamespaceToOpenPropName, ns) + | Some ns -> completionItem//.AddProperty(NamespaceToOpenPropName, ns) | None -> completionItem - let completionItem = completionItem.AddProperty(IndexPropName, string number) + let completionItem = completionItem//.AddProperty(IndexPropName, string number) let priority = match mruItems.TryGetValue declarationItem.FullName with @@ -180,54 +174,36 @@ type internal FSharpCompletionProvider | _ -> number + maxHints + 1 let sortText = priority.ToString("D6") - let completionItem = completionItem.WithSortText(sortText) + let completionItem = completionItem//.WithSortText(sortText) results.Add(completionItem)) if results.Count > 0 && not declarations.IsForType && not declarations.IsError && List.isEmpty partialName.QualifyingIdents then let lineStr = textLines.[caretLinePos.Line].ToString() - + let completionContext = parseResults.ParseTree |> Option.bind (fun parseTree -> UntypedParseImpl.TryGetCompletionContext(Pos.fromZ caretLinePos.Line caretLinePos.Character, parseTree, lineStr)) - + + let image = GlyphHelper.getImageId Glyph.Keyword |> ImageElement + match completionContext with - | None -> results.AddRange(keywordCompletionItems) + | None -> + let keywordItemsWithSource = + keywordCompletionItems + |> Seq.mapi (fun n (keyword, description) -> + new Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionItem + (keyword, completionSource, image, ImmutableArray.Empty, "", keyword, sprintf "%06d" (1000000 + n), keyword, keyword, ImmutableArray.Empty )) + + results.AddRange(keywordItemsWithSource) | _ -> () - + return results } - override this.ShouldTriggerCompletion(sourceText: SourceText, caretPosition: int, trigger: CompletionTrigger, _: OptionSet) = - use _logBlock = Logger.LogBlock LogEditorFunctionId.Completion_ShouldTrigger - - let getInfo() = - let documentId = workspace.GetDocumentIdInCurrentContext(sourceText.Container) - let document = workspace.CurrentSolution.GetDocument(documentId) - let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document) - (documentId, document.FilePath, defines) - - FSharpCompletionProvider.ShouldTriggerCompletionAux(sourceText, caretPosition, trigger.Kind, getInfo, settings.IntelliSense) - override this.ProvideCompletionsAsync(context: Completion.CompletionContext) = asyncMaybe { - use _logBlock = Logger.LogBlockMessage context.Document.Name LogEditorFunctionId.Completion_ProvideCompletionsAsync - - let document = context.Document - let! sourceText = context.Document.GetTextAsync(context.CancellationToken) - let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document) - do! Option.guard (CompletionUtils.shouldProvideCompletion(document.Id, document.FilePath, defines, sourceText, context.Position)) - let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document, context.CancellationToken) - let! textVersion = context.Document.GetTextVersionAsync(context.CancellationToken) - let getAllSymbols(fileCheckResults: FSharpCheckFileResults) = - if settings.IntelliSense.IncludeSymbolsFromUnopenedNamespacesOrModules - then assemblyContentProvider.GetAllEntitiesInProjectAndReferencedAssemblies(fileCheckResults) - else [] - let! results = - FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, sourceText, context.Position, projectOptions, document.FilePath, - textVersion.GetHashCode(), getAllSymbols, settings.LanguageServicePerformance, settings.IntelliSense) - - context.AddItems(results) + context.AddItems([])//results) } |> Async.Ignore |> RoslynHelpers.StartAsyncUnitAsTask context.CancellationToken override this.GetDescriptionAsync(document: Document, completionItem: Completion.CompletionItem, cancellationToken: CancellationToken): Task = @@ -250,6 +226,20 @@ type internal FSharpCompletionProvider return CompletionDescription.Empty } |> RoslynHelpers.StartAsyncAsTask cancellationToken + member this.GetDescriptionAsync2(textView: ITextView, completionItem: Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionItem, cancellationToken: CancellationToken): Task = + async { + match completionItem.Properties.TryGetProperty IndexPropName with + | true, (declarationItem: FSharpDeclarationListItem) -> + let! description = declarationItem.StructuredDescriptionTextAsync + let documentation = List() + let collector = RoslynHelpers.CollectTaggedText documentation + // mix main description and xmldoc by using one collector + XmlDocumentation.BuildDataTipText(documentationBuilder, collector, collector, collector, collector, collector, description) + return CompletionDescription.Create(documentation.ToImmutableArray()) + | _ -> + return CompletionDescription.Empty + } |> RoslynHelpers.StartAsyncAsTask cancellationToken + override this.GetChangeAsync(document, item, _, cancellationToken) : Task = async { use _logBlock = Logger.LogBlockMessage document.Name LogEditorFunctionId.Completion_GetChangeAsync diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionService.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionService.fs index 6303e2498d2..fdaa2cfd519 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionService.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionService.fs @@ -2,21 +2,29 @@ namespace Microsoft.VisualStudio.FSharp.Editor -open System.Composition open System.Collections.Immutable open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Completion -open Microsoft.CodeAnalysis.Host -open Microsoft.CodeAnalysis.Host.Mef +open Microsoft.CodeAnalysis.ExternalAccess.FSharp +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Completion +open System.ComponentModel.Composition +open Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion +open Microsoft.VisualStudio.Text.Editor +open System.Threading.Tasks -open Microsoft.VisualStudio.Shell +open System.Collections.Generic; +open Microsoft.CodeAnalysis.Classification +open Microsoft.CodeAnalysis.Text; +open Microsoft.VisualStudio.Text; +open Microsoft.VisualStudio.Text.Adornments; + +open FSharp.Compiler.SourceCodeServices type internal FSharpCompletionService ( workspace: Workspace, - serviceProvider: SVsServiceProvider, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, assemblyContentProvider: AssemblyContentProvider, @@ -26,7 +34,7 @@ type internal FSharpCompletionService let builtInProviders = ImmutableArray.Create( - FSharpCompletionProvider(workspace, serviceProvider, checkerProvider, projectInfoManager, assemblyContentProvider), + FSharpCompletionProvider(workspace, checkerProvider, projectInfoManager, assemblyContentProvider), FSharpCommonCompletionProvider.Create( HashDirectiveCompletionProvider(workspace, projectInfoManager, [ Completion.Create("""\s*#load\s+(@?"*(?"[^"]*"?))""", [".fs"; ".fsx"], useIncludeDirectives = true) @@ -47,19 +55,278 @@ type internal FSharpCompletionService .WithDismissIfLastCharacterDeleted(true) .WithDefaultEnterKeyRule(enterKeyRule) -[] -[, FSharpConstants.FSharpLanguageName)>] -type internal FSharpCompletionServiceFactory +type internal FSharpCompletionSource + (textView: ITextView, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, assemblyContentProvider: AssemblyContentProvider) = + + + let createParagraphFromLines(lines: List) = + if lines.Count = 1 then + // The paragraph contains only one line, so it doesn't need to be added to a container. Avoiding the + // wrapping container here also avoids a wrapping element in the Cocoa elements used for rendering, + // improving efficiency. + lines.[0] :> obj + else + // The lines of a multi-line paragraph are stacked to produce the full paragraph. + ContainerElement(ContainerElementStyle.Stacked, lines |> Seq.map box) :> obj + + let toClassificationTypeName = function + | TextTags.Keyword -> + ClassificationTypeNames.Keyword + + | TextTags.Class -> + ClassificationTypeNames.ClassName + + | TextTags.Delegate -> + ClassificationTypeNames.DelegateName + + | TextTags.Enum -> + ClassificationTypeNames.EnumName + + | TextTags.Interface -> + ClassificationTypeNames.InterfaceName + + | TextTags.Module -> + ClassificationTypeNames.ModuleName + + | TextTags.Struct -> + ClassificationTypeNames.StructName + + | TextTags.TypeParameter -> + ClassificationTypeNames.TypeParameterName + + | TextTags.Field -> + ClassificationTypeNames.FieldName + + | TextTags.Event -> + ClassificationTypeNames.EventName + + | TextTags.Label -> + ClassificationTypeNames.LabelName + + | TextTags.Local -> + ClassificationTypeNames.LocalName + + | TextTags.Method -> + ClassificationTypeNames.MethodName + + | TextTags.Namespace -> + ClassificationTypeNames.NamespaceName + + | TextTags.Parameter -> + ClassificationTypeNames.ParameterName + + | TextTags.Property -> + ClassificationTypeNames.PropertyName + + | TextTags.ExtensionMethod -> + ClassificationTypeNames.ExtensionMethodName + + | TextTags.EnumMember -> + ClassificationTypeNames.EnumMemberName + + | TextTags.Constant -> + ClassificationTypeNames.ConstantName + + | TextTags.Alias + | TextTags.Assembly + | TextTags.ErrorType + | TextTags.RangeVariable -> + ClassificationTypeNames.Identifier + + | TextTags.NumericLiteral -> + ClassificationTypeNames.NumericLiteral + + | TextTags.StringLiteral -> + ClassificationTypeNames.StringLiteral + + | TextTags.Space + | TextTags.LineBreak -> + ClassificationTypeNames.WhiteSpace + + | TextTags.Operator -> + ClassificationTypeNames.Operator + + | TextTags.Punctuation -> + ClassificationTypeNames.Punctuation + + | TextTags.AnonymousTypeIndicator + | TextTags.Text + | _ -> + ClassificationTypeNames.Text + + + let buildClassifiedTextElements (taggedTexts:ImmutableArray) = + // This method produces a sequence of zero or more paragraphs + let paragraphs = new List() + + // Each paragraph is constructed from one or more lines + let currentParagraph = new List() + + // Each line is constructed from one or more inline elements + let currentRuns = new List() + + for part in taggedTexts do + if part.Tag = TextTags.LineBreak then + if currentRuns.Count > 0 then + // This line break means the end of a line within a paragraph. + currentParagraph.Add(new ClassifiedTextElement(currentRuns)); + currentRuns.Clear(); + else + // This line break means the end of a paragraph. Empty paragraphs are ignored, but could appear + // in the input to this method: + // + // * Empty elements + // * Explicit line breaks at the start of a comment + // * Multiple line breaks between paragraphs + if currentParagraph.Count > 0 then + // The current paragraph is not empty, so add it to the result collection + paragraphs.Add(createParagraphFromLines(currentParagraph)) + currentParagraph.Clear(); + + else + // This is tagged text getting added to the current line we are building. + currentRuns.Add(new ClassifiedTextRun(part.Tag |> toClassificationTypeName, part.Text)) + + if currentRuns.Count > 0 then + // Add the final line to the final paragraph. + currentParagraph.Add(new ClassifiedTextElement(currentRuns)) + + if currentParagraph.Count > 0 then + // Add the final paragraph to the result. + paragraphs.Add(createParagraphFromLines(currentParagraph)) + + paragraphs + /// + /// Called when user interacts with expander buttons, + /// requesting the completion source to provide additional completion items pertinent to the expander button. + /// For best performance, do not provide unless expansion should add new filters. + /// Called on a background thread. + /// + /// Reference to the active + /// Expander which caused this call + /// What initially caused the completion + /// Location where completion will take place, on the view's data buffer: + /// Cancellation token that may interrupt this operation + /// A struct that holds completion items and applicable span + let commitChars = [|' '; '='; ','; '.'; '<'; '>'; '('; ')'; '!'; ':'; '['; ']'; '|'|].ToImmutableArray() + interface IAsyncExpandingCompletionSource with + member __.GetExpandedCompletionContextAsync(session, expander, initialTrigger, applicableToSpan, token) = + let ctx = Data.CompletionContext.Empty + Task.FromResult ctx + + + interface IAsyncCompletionSource with + member this.GetCompletionContextAsync(session, trigger, triggerLocation, applicableToSpan, token) = + async { + System.Diagnostics.Trace.WriteLine("GetCompletionContextAsync") + let document = session.TextView.TextSnapshot.GetOpenDocumentInCurrentContextWithChanges() + + let sourceText = session.TextView.TextSnapshot.AsText() + let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document, token) + match options with + | Some (_parsingOptions, projectOptions) -> + let! textVersion = document.GetTextVersionAsync(token) |> liftTaskAsync + let getAllSymbols(fileCheckResults: FSharpCheckFileResults) = + [] + //if settings.IntelliSense.IncludeSymbolsFromUnopenedNamespacesOrModules + //then assemblyContentProvider.GetAllEntitiesInProjectAndReferencedAssemblies(fileCheckResults) + //else [] + + + session.TextView.Properties.["PotentialCommitCharacters"] <- commitChars + let! completions = FSharpCompletionProvider.ProvideCompletionsAsyncAux(this, checkerProvider.Checker, sourceText, triggerLocation.Position, projectOptions, document.FilePath, textVersion.GetHashCode(), getAllSymbols, (*settings.LanguageServicePerformance*) LanguageServicePerformanceOptions.Default, (*settings.IntelliSense*) IntelliSenseOptions.Default) + match completions with + | Some completions' -> + return new Data.CompletionContext(completions'.ToImmutableArray()) + | None -> + return Data.CompletionContext.Empty + | _ -> + return Data.CompletionContext.Empty + } |> RoslynHelpers.StartAsyncAsTask token + + /// + /// Returns tooltip associated with provided . + /// The returned object will be rendered by . See its documentation for default supported types. + /// You may export a to provide a renderer for a custom type. + /// Since this method is called on a background thread and on multiple platforms, an instance of UIElement may not be returned. + /// + /// Reference to the active + /// which is a subject of the tooltip + /// Cancellation token that may interrupt this operation + /// An object that will be passed to . See its documentation for supported types. + member __.GetDescriptionAsync(session, item, token) = + async { + let document = session.TextView.TextSnapshot.GetOpenDocumentInCurrentContextWithChanges() + //let! sourceText = document.GetTextAsync() |> Async.AwaitTask + let provider = FSharpCompletionProvider(document.Project.Solution.Workspace, checkerProvider, projectInfoManager, assemblyContentProvider) + let! description = provider.GetDescriptionAsync2(session.TextView, item, token) |> Async.AwaitTask + let elements = description.TaggedParts |> buildClassifiedTextElements + return ContainerElement(ContainerElementStyle.Stacked ||| ContainerElementStyle.VerticalPadding, elements |> Seq.map box) :> obj + //return elements :> obj + } |> RoslynHelpers.StartAsyncAsTask token + + /// + /// Provides the span applicable to the prospective session. + /// Called on UI thread and expected to return very quickly, based on syntactic clues. + /// This method is called as a result of user action, after the Editor makes necessary changes in direct response to user's action. + /// The state of the Editor prior to making the text edit is captured in of . + /// This method is called sequentially on available s until one of them returns + /// with appropriate level of + /// and one returns with + /// If neither of the above conditions are met, no completion session will start. + /// + /// + /// If a language service does not wish to participate in completion, it should try to provide a valid + /// and set to false. + /// This will enable other extensions to provide completion in syntactically appropriate location. + /// + /// What causes the completion, including the character typed and reference to prior to triggering the completion + /// Location on the subject buffer that matches this 's content type + /// Cancellation token that may interrupt this operation + /// Whether this wishes to participate in completion. + member __.InitializeCompletion(trigger, triggerLocation, token) = + System.Diagnostics.Trace.WriteLine("initialize") + use _logBlock = Logger.LogBlock LogEditorFunctionId.Completion_ShouldTrigger + + let document = triggerLocation.Snapshot.GetOpenDocumentInCurrentContextWithChanges() + + let getInfo() = + let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document) + (document.Id, document.FilePath, defines) + + + let sourceText = triggerLocation.Snapshot.AsText() + let shouldTrigger = + FSharpCompletionProvider.ShouldTriggerCompletionAux(sourceText, triggerLocation.Position, trigger, getInfo, (*settings.IntelliSense*) IntelliSenseOptions.Default) + + match shouldTrigger with + | false -> + Data.CompletionStartData.DoesNotParticipateInCompletion + | true -> + Data.CompletionStartData( + participation = Data.CompletionParticipation.ProvidesItems, + applicableToSpan = new SnapshotSpan( + triggerLocation.Snapshot, + CompletionUtils.getCompletionItemSpan sourceText triggerLocation.Position)) + +[)>] +[)>] +[] +[] +type internal CompletionSourceProvider [] ( - serviceProvider: SVsServiceProvider, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, - assemblyContentProvider: AssemblyContentProvider, - settings: EditorOptions + assemblyContentProvider: AssemblyContentProvider ) = - interface ILanguageServiceFactory with - member this.CreateLanguageService(hostLanguageServices: HostLanguageServices) : ILanguageService = - upcast new FSharpCompletionService(hostLanguageServices.WorkspaceServices.Workspace, serviceProvider, checkerProvider, projectInfoManager, assemblyContentProvider, settings) + interface IAsyncCompletionSourceProvider with + member __.GetOrCreate(textView) = + System.Diagnostics.Trace.WriteLine("Completion .ctor") + new FSharpCompletionSource(textView, checkerProvider, projectInfoManager, assemblyContentProvider) :> _ + interface IAsyncCompletionCommitManagerProvider with + member __.GetOrCreate(_textView) = + System.Diagnostics.Trace.WriteLine("GetOrCreate FSharpAsyncCompletionCommitManager") + FSharpAsyncCompletionCommitManager() :> _ diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs index 5d210d5f363..4ce504f6d47 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs @@ -11,7 +11,7 @@ open Microsoft.CodeAnalysis.Completion open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Completion open System.Globalization open FSharp.Compiler.SourceCodeServices - +open Microsoft.VisualStudio.Text module internal CompletionUtils = let private isLetterChar (cat: UnicodeCategory) = @@ -110,4 +110,35 @@ module internal CompletionUtils = | CompletionItemKind.Event -> 4 | CompletionItemKind.Argument -> 5 | CompletionItemKind.Other -> 6 - | CompletionItemKind.Method (isExtension = true) -> 7 \ No newline at end of file + | CompletionItemKind.Method (isExtension = true) -> 7 + + let getCompletionItemSpan (sourceText: SourceText) position = + let rec findStart index = + let c = sourceText.[index-1] + match isIdentifierStartCharacter c with + | true when index > 1 -> + findStart (index-1) + | _ -> index + + // If we're brought up in the middle of a word, extend to the end of the word as well. + // This means that if a user brings up the completion list at the start of the word they + // will "insert" the text before what's already there (useful for qualifying existing + // text). However, if they bring up completion in the "middle" of a word, then they will + // "overwrite" the text. Useful for correcting misspellings or just replacing unwanted + // code with new code. + let rec findEnd index = + let c = sourceText.[index] + match isIdentifierStartCharacter c with + | true when index < sourceText.Length -> + findEnd (index+1) + | _ -> index + + let start = findStart position + + let endIndex = + if start <> position && position < sourceText.Length then + findEnd position + else + position + + Span.FromBounds(start, endIndex) diff --git a/vsintegration/src/FSharp.Editor/Completion/GlyphHelper.fs b/vsintegration/src/FSharp.Editor/Completion/GlyphHelper.fs new file mode 100644 index 00000000000..1784fe2e3b4 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Completion/GlyphHelper.fs @@ -0,0 +1,208 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor +open System +open Microsoft.CodeAnalysis.Tags; +open Microsoft.VisualStudio.Core.Imaging; +open Microsoft.VisualStudio.Imaging; +module GlyphHelper = + // hardcode imageCatalogGuid locally rather than calling KnownImageIds.ImageCatalogGuid + // So it does not have dependency on Microsoft.VisualStudio.ImageCatalog.dll + // https://github.com/dotnet/roslyn/issues/26642 + let imageCatalogGuid = Guid.Parse("ae27a6b0-e345-4288-96df-5eaf394ee369"); + + let getImageId (glyph:Microsoft.CodeAnalysis.ExternalAccess.FSharp.FSharpGlyph) = + // VS for mac cannot refer to ImageMoniker + // so we need to expose ImageId instead of ImageMoniker here + // and expose ImageMoniker in the EditorFeatures.wpf.dll + match glyph with + | Glyph.None -> + new ImageId(imageCatalogGuid, KnownImageIds.None) + + | Glyph.Assembly -> + new ImageId(imageCatalogGuid, KnownImageIds.Assembly) + + | Glyph.BasicFile -> + new ImageId(imageCatalogGuid, KnownImageIds.VBFileNode) + | Glyph.BasicProject -> + new ImageId(imageCatalogGuid, KnownImageIds.VBProjectNode) + + | Glyph.ClassPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.ClassPublic) + | Glyph.ClassProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.ClassProtected) + | Glyph.ClassPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.ClassPrivate) + | Glyph.ClassInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.ClassInternal) + + | Glyph.CSharpFile -> + new ImageId(imageCatalogGuid, KnownImageIds.CSFileNode) + | Glyph.CSharpProject -> + new ImageId(imageCatalogGuid, KnownImageIds.CSProjectNode) + + | Glyph.ConstantPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.ConstantPublic) + | Glyph.ConstantProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.ConstantProtected) + | Glyph.ConstantPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.ConstantPrivate) + | Glyph.ConstantInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.ConstantInternal) + + | Glyph.DelegatePublic -> + new ImageId(imageCatalogGuid, KnownImageIds.DelegatePublic) + | Glyph.DelegateProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.DelegateProtected) + | Glyph.DelegatePrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.DelegatePrivate) + | Glyph.DelegateInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.DelegateInternal) + + | Glyph.EnumPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.EnumerationPublic) + | Glyph.EnumProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.EnumerationProtected) + | Glyph.EnumPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.EnumerationPrivate) + | Glyph.EnumInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.EnumerationInternal) + + | Glyph.EnumMemberPublic + | Glyph.EnumMemberProtected + | Glyph.EnumMemberPrivate + | Glyph.EnumMemberInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.EnumerationItemPublic) + + | Glyph.Error -> + new ImageId(imageCatalogGuid, KnownImageIds.StatusError) + + | Glyph.EventPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.EventPublic) + | Glyph.EventProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.EventProtected) + | Glyph.EventPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.EventPrivate) + | Glyph.EventInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.EventInternal) + + // Extension methods have the same glyph regardless of accessibility. + | Glyph.ExtensionMethodPublic + | Glyph.ExtensionMethodProtected + | Glyph.ExtensionMethodPrivate + | Glyph.ExtensionMethodInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.ExtensionMethod); + + | Glyph.FieldPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.FieldPublic) + | Glyph.FieldProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.FieldProtected) + | Glyph.FieldPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.FieldPrivate) + | Glyph.FieldInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.FieldInternal) + + | Glyph.InterfacePublic -> + new ImageId(imageCatalogGuid, KnownImageIds.InterfacePublic) + | Glyph.InterfaceProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.InterfaceProtected) + | Glyph.InterfacePrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.InterfacePrivate) + | Glyph.InterfaceInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.InterfaceInternal) + + // TODO: Figure out the right thing to return here. + | Glyph.Intrinsic -> + new ImageId(imageCatalogGuid, KnownImageIds.Type) + + | Glyph.Keyword -> + new ImageId(imageCatalogGuid, KnownImageIds.IntellisenseKeyword) + + | Glyph.Label -> + new ImageId(imageCatalogGuid, KnownImageIds.Label) + + | Glyph.Parameter + | Glyph.Local -> + new ImageId(imageCatalogGuid, KnownImageIds.LocalVariable); + + | Glyph.Namespace -> + new ImageId(imageCatalogGuid, KnownImageIds.Namespace) + + | Glyph.MethodPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.MethodPublic) + | Glyph.MethodProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.MethodProtected) + | Glyph.MethodPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.MethodPrivate) + | Glyph.MethodInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.MethodInternal) + + | Glyph.ModulePublic -> + new ImageId(imageCatalogGuid, KnownImageIds.ModulePublic) + | Glyph.ModuleProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.ModuleProtected) + | Glyph.ModulePrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.ModulePrivate) + | Glyph.ModuleInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.ModuleInternal) + + | Glyph.OpenFolder -> + new ImageId(imageCatalogGuid, KnownImageIds.OpenFolder) + + | Glyph.Operator -> + new ImageId(imageCatalogGuid, KnownImageIds.Operator) + + | Glyph.PropertyPublic -> + new ImageId(imageCatalogGuid, KnownImageIds.PropertyPublic) + | Glyph.PropertyProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.PropertyProtected) + | Glyph.PropertyPrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.PropertyPrivate) + | Glyph.PropertyInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.PropertyInternal) + + | Glyph.RangeVariable -> + new ImageId(imageCatalogGuid, KnownImageIds.FieldPublic) + + | Glyph.Reference -> + new ImageId(imageCatalogGuid, KnownImageIds.Reference) + + //// this is not a copy-paste mistake, we were using these before in the previous GetImageMoniker() + //| Glyph.StructurePublic -> + // return KnownMonikers.ValueTypePublic + //| Glyph.StructureProtected -> + // return KnownMonikers.ValueTypeProtected + //| Glyph.StructurePrivate -> + // return KnownMonikers.ValueTypePrivate + //| Glyph.StructureInternal -> + // return KnownMonikers.ValueTypeInternal + + | Glyph.StructurePublic -> + new ImageId(imageCatalogGuid, KnownImageIds.ValueTypePublic) + | Glyph.StructureProtected -> + new ImageId(imageCatalogGuid, KnownImageIds.ValueTypeProtected) + | Glyph.StructurePrivate -> + new ImageId(imageCatalogGuid, KnownImageIds.ValueTypePrivate) + | Glyph.StructureInternal -> + new ImageId(imageCatalogGuid, KnownImageIds.ValueTypeInternal) + + | Glyph.TypeParameter -> + new ImageId(imageCatalogGuid, KnownImageIds.Type) + + | Glyph.Snippet -> + new ImageId(imageCatalogGuid, KnownImageIds.Snippet) + + | Glyph.CompletionWarning -> + new ImageId(imageCatalogGuid, KnownImageIds.IntellisenseWarning) + + | Glyph.StatusInformation -> + new ImageId(imageCatalogGuid, KnownImageIds.StatusInformation) + + | Glyph.NuGet -> + new ImageId(imageCatalogGuid, KnownImageIds.NuGet) + + //| Glyph.TargetTypeMatch -> + //new ImageId(imageCatalogGuid, KnownImageIds.MatchType) + + | _ -> + raise(new ArgumentException("glyph")) diff --git a/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs b/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs index cde4f1d22dd..7a8f22262e4 100644 --- a/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs +++ b/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs @@ -2,19 +2,13 @@ namespace Microsoft.VisualStudio.FSharp.Editor -open System open System.Composition open System.Collections.Generic open Microsoft.CodeAnalysis -open Microsoft.CodeAnalysis.SignatureHelp open Microsoft.CodeAnalysis.Text open Microsoft.CodeAnalysis.ExternalAccess.FSharp.SignatureHelp -open Microsoft.VisualStudio.Text -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop - open FSharp.Compiler.Layout open FSharp.Compiler.Range open FSharp.Compiler.SourceCodeServices @@ -24,19 +18,18 @@ open FSharp.Compiler.SourceCodeServices type internal FSharpSignatureHelpProvider [] ( - serviceProvider: SVsServiceProvider, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager ) = static let userOpName = "SignatureHelpProvider" - let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder(serviceProvider.XMLMemberIndexService) + let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder() static let oneColAfter (lp: LinePosition) = LinePosition(lp.Line,lp.Character+1) static let oneColBefore (lp: LinePosition) = LinePosition(lp.Line,max 0 (lp.Character-1)) // Unit-testable core routine - static member internal ProvideMethodsAsyncAux(checker: FSharpChecker, documentationBuilder: IDocumentationBuilder, sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, triggerIsTypedChar: char option, filePath: string, textVersionHash: int) = async { + static member internal ProvideMethodsAsyncAux(checker:FSharpChecker, documentationBuilder: IDocumentationBuilder, sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, triggerIsTypedChar: char option, filePath: string, textVersionHash: int) = async { let! parseResults, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, textVersionHash, sourceText.ToFSharpSourceText(), options, userOpName = userOpName) match checkFileAnswer with | FSharpCheckFileAnswer.Aborted -> return None diff --git a/vsintegration/src/FSharp.Editor/Debugging/BreakpointSpanResolver.fs b/vsintegration/src/FSharp.Editor/Debugging/BreakpointSpanResolver.fs new file mode 100644 index 00000000000..64cae3275c7 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Debugging/BreakpointSpanResolver.fs @@ -0,0 +1,89 @@ +// +// BreakpointSpanResolver.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. + +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Threading.Tasks + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Text +open Microsoft.VisualStudio.Text + +open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Range + +open MonoDevelop.Debugger +open MonoDevelop.Ide.Gui.Documents + +// The breakpoint span resolver is using Mono.Addins rather than MEF +[] +type internal BreakpointSpanResolver() = + inherit DocumentControllerExtension() + + static let userOpName = "BreakpointResolution" + + let getCheckerService(document: Document) = + document.Project.Solution.Workspace.Services.GetService() + + let fsharpRangeToSpan(sourceText: SourceText, range: range) = + let startPosition = sourceText.Lines.[max 0 (range.StartLine - 1)].Start + range.StartColumn + let endPosition = sourceText.Lines.[min (range.EndLine - 1) (sourceText.Lines.Count - 1)].Start + range.EndColumn + Span(startPosition, endPosition - startPosition) + + member x.SupportsController(controller: DocumentController) = + Task.FromResult(controller.GetContent() <> null) + + static member GetBreakpointLocation(checker: FSharpChecker, sourceText: SourceText, fileName: string, position: int, parsingOptions: FSharpParsingOptions) = + async { + let textLinePos = sourceText.Lines.GetLinePosition(position) + let textInLine = sourceText.GetSubText(sourceText.Lines.[textLinePos.Line].Span).ToString() + + if String.IsNullOrWhiteSpace textInLine then + return None + else + let textLineColumn = textLinePos.Character + let fcsTextLineNumber = Line.fromZ textLinePos.Line // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based + let! parseResults = checker.ParseFile(fileName, sourceText.ToFSharpSourceText(), parsingOptions, userOpName = userOpName) + return parseResults.ValidateBreakpointLocation(mkPos fcsTextLineNumber textLineColumn) + } + + interface IBreakpointSpanResolver with + member x.GetBreakpointSpanAsync(buffer, position, cancellationToken) = + let getLineSpan() = + buffer.CurrentSnapshot.GetLineFromPosition(max 0 (min position (buffer.CurrentSnapshot.Length - 1))).Extent.Span + + asyncMaybe { + let! document = buffer.CurrentSnapshot.GetRelatedDocumentsWithChanges() |> Seq.tryHead + let checkerService = getCheckerService document + let projectInfoManager = checkerService.FSharpProjectOptionsManager + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document, cancellationToken) + let sourceText = buffer.AsTextContainer().CurrentText + let! range = BreakpointSpanResolver.GetBreakpointLocation(checkerService.Checker, sourceText, document.Name, position, parsingOptions) + return fsharpRangeToSpan(sourceText, range) + } + |> Async.map (Option.defaultWith getLineSpan) + |> RoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/Debugging/LanguageDebugInfoService.fs b/vsintegration/src/FSharp.Editor/Debugging/LanguageDebugInfoService.fs index cf37cf08aa6..8d76245ab72 100644 --- a/vsintegration/src/FSharp.Editor/Debugging/LanguageDebugInfoService.fs +++ b/vsintegration/src/FSharp.Editor/Debugging/LanguageDebugInfoService.fs @@ -32,6 +32,7 @@ type internal FSharpLanguageDebugInfoService [](projectInf | ClassificationTypeNames.StringLiteral -> Some(token.TextSpan) + | ClassificationTypeNames.LocalName | ClassificationTypeNames.Identifier -> let textLine = sourceText.Lines.GetLineFromPosition(position) let textLinePos = sourceText.Lines.GetLinePosition(position) diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs index 273e0bad4b6..eb027c691cf 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs @@ -62,7 +62,17 @@ type internal FSharpDocumentDiagnosticAnalyzer [] () = static member GetDiagnostics(checker: FSharpChecker, filePath: string, sourceText: SourceText, textVersionHash: int, parsingOptions: FSharpParsingOptions, options: FSharpProjectOptions, diagnosticType: DiagnosticsType) = async { let fsSourceText = sourceText.ToFSharpSourceText() - let! parseResults = checker.ParseFile(filePath, fsSourceText, parsingOptions, userOpName=userOpName) + + let! parseResults = + try + checker.ParseFile(filePath, fsSourceText, parsingOptions, userOpName=userOpName) + with + | :? StackOverflowException as e -> + LoggingService.logError "%s" (e.ToString()) + LoggingService.logError "StackOverflow while parsing %s" filePath + failwithf "StackOverflow parsing %s" filePath + + let! errors = async { match diagnosticType with diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs index ff7c43839d0..a40c3aed955 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs @@ -21,7 +21,7 @@ type internal UnusedDeclarationsAnalyzer [] () = static let userOpName = "UnusedDeclarationsAnalyzer" let getProjectInfoManager (document: Document) = document.Project.Solution.Workspace.Services.GetService().FSharpProjectOptionsManager let getChecker (document: Document) = document.Project.Solution.Workspace.Services.GetService().Checker - + let isPotentiallyUnusedDeclaration (symbol: FSharpSymbol) : bool = match symbol with // Determining that a record, DU or module is used anywhere requires inspecting all their enclosed entities (fields, cases and func / vals) diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index c79027b0dff..d856f65b4e2 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -46,6 +46,13 @@ type internal UnusedOpensDiagnosticAnalyzer [] () = interface IFSharpUnusedOpensDiagnosticAnalyzer with member this.AnalyzeSemanticsAsync(descriptor, document: Document, cancellationToken: CancellationToken) = + let isOpen = + MonoDevelop.Ide.IdeApp.Workbench.Documents + |> Seq.exists(fun d -> d.FilePath |> string = document.FilePath) + + if not isOpen then + Task.FromResult ImmutableArray.Empty + else asyncMaybe { do Trace.TraceInformation("{0:n3} (start) UnusedOpensAnalyzer", DateTime.Now.TimeOfDay.TotalSeconds) do! Async.Sleep DefaultTuning.UnusedOpensAnalyzerInitialDelay |> liftAsync // be less intrusive, give other work priority most of the time diff --git a/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs b/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs index 09a7951e047..93f1b5867c4 100644 --- a/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs +++ b/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs @@ -5,12 +5,20 @@ namespace Microsoft.VisualStudio.FSharp.Editor open System open System.Runtime.CompilerServices open System.Text.RegularExpressions -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop open FSharp.Compiler.SourceCodeServices open FSharp.Compiler.Layout open FSharp.Compiler.Layout.TaggedTextOps open System.Collections.Generic +open System.IO +open System.Threading +open Microsoft.CodeAnalysis.Text; +open Microsoft.CodeAnalysis.Text.Shared.Extensions; +open Microsoft.VisualStudio.Core.Imaging; +open Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion; +open Microsoft.VisualStudio.Text; +open Microsoft.VisualStudio.Text.Adornments; +open Microsoft.VisualStudio.Text.Editor; +open System.Collections.Immutable type internal ITaggedTextCollector = abstract Add: text: TaggedText -> unit @@ -84,6 +92,83 @@ type internal IDocumentationBuilder = /// Documentation helpers. module internal XmlDocumentation = open System.Security + open System.Collections.Generic + open Internal.Utilities.StructuredFormat + open Microsoft.CodeAnalysis.Classification + open FSharp.Compiler + open Microsoft.VisualStudio.Core.Imaging + open Microsoft.VisualStudio.Language.StandardClassification + open Microsoft.VisualStudio.Text.Adornments + let layoutTagToClassificationTag (layoutTag:LayoutTag) = + match layoutTag with + | ActivePatternCase + | ActivePatternResult + | UnionCase + | Enum -> ClassificationTypeNames.EnumName // Roslyn-style classification name + | Alias + | Class + | Module + | Record + | Struct + | TypeParameter + | Union + | UnknownType -> PredefinedClassificationTypeNames.Type + | Interface -> ClassificationTypeNames.InterfaceName // Roslyn-style classification name + | Keyword -> PredefinedClassificationTypeNames.Keyword + | Delegate + | Event + | Field + | Local + | Member + | Method + | ModuleBinding + | Namespace + | Parameter + | Property + | RecordField -> PredefinedClassificationTypeNames.Identifier + | LineBreak + | Space -> PredefinedClassificationTypeNames.WhiteSpace + | NumericLiteral -> PredefinedClassificationTypeNames.Number + | Operator -> PredefinedClassificationTypeNames.Operator + | StringLiteral -> PredefinedClassificationTypeNames.String + | Punctuation + | Text + | UnknownEntity -> PredefinedClassificationTypeNames.Other + + let buildContainerElement (itemGroup:ImmutableArray) = + let finalCollection = List() + let currentContainerItems = List() + let runsCollection = List() + let flushRuns() = + if runsCollection.Count > 0 then + let element = ClassifiedTextElement(runsCollection) + currentContainerItems.Add(element :> obj) + runsCollection.Clear() + let flushContainer() = + if currentContainerItems.Count > 0 then + let element = ContainerElement(ContainerElementStyle.Wrapped, currentContainerItems) + finalCollection.Add(element) + currentContainerItems.Clear() + for item in itemGroup do + let classificationTag = layoutTagToClassificationTag item.Tag + match item with + //| :? NavigableTaggedText as nav when navigation.IsTargetValid nav.Range -> + //flushRuns() + //let navigableTextRun = NavigableTextRun(classificationTag, item.Text, fun () -> navigation.NavigateTo nav.Range) + //currentContainerItems.Add(navigableTextRun :> obj) + | _ when item.Tag = LineBreak -> + flushRuns() + // preserve succesive linebreaks + if currentContainerItems.Count = 0 then + runsCollection.Add(ClassifiedTextRun(PredefinedClassificationTypeNames.Other, System.String.Empty)) + flushRuns() + flushContainer() + | _ -> + let newRun = ClassifiedTextRun(classificationTag, item.Text) + runsCollection.Add(newRun) + flushRuns() + flushContainer() + ContainerElement(ContainerElementStyle.Stacked, finalCollection |> Seq.map box) /// If the XML comment starts with '<' not counting whitespace then treat it as a literal XML comment. /// Otherwise, escape it and surround it with @@ -210,28 +295,33 @@ module internal XmlDocumentation = type VsThreadToken() = class end let vsToken = VsThreadToken() - - /// Provide Xml Documentation - type Provider(xmlIndexService:IVsXMLMemberIndexService) = - /// Index of assembly name to xml member index. - let cache = Dictionary() - - do Events.SolutionEvents.OnAfterCloseSolution.Add (fun _ -> cache.Clear()) - - /// Retrieve the pre-existing xml index or None - let GetMemberIndexOfAssembly(assemblyName) = - match cache.TryGetValue(assemblyName) with - | true, memberIndex -> Some(memberIndex) - | false, _ -> - let ok,memberIndex = xmlIndexService.CreateXMLMemberIndex(assemblyName) - if Com.Succeeded(ok) then - let ok = memberIndex.BuildMemberIndex() - if Com.Succeeded(ok) then - cache.Add(assemblyName, memberIndex) - Some(memberIndex) - else None - else None + type FSharpXmlDocumentationProvider(assemblyPath) = + inherit Microsoft.CodeAnalysis.XmlDocumentationProvider() + let xmlPath = Path.ChangeExtension(assemblyPath, ".xml") + let xmlExists = File.Exists xmlPath + member x.XmlPath = xmlPath + member x.GetDocumentation documentationCommentId = + match xmlExists with + | true -> + let xml = base.GetDocumentationForSymbol(documentationCommentId, Globalization.CultureInfo.CurrentCulture, CancellationToken.None) + xml + | false -> "" + + override x.GetSourceStream(_cancellationToken) = + new FileStream(xmlPath, FileMode.Open, FileAccess.Read) :> Stream + + override x.Equals(obj) = + match obj with + | :? FSharpXmlDocumentationProvider as provider -> + provider.XmlPath = xmlPath + | _ -> + false + + override x.GetHashCode() = xmlPath.GetHashCode() + + /// Provide Xml Documentation + type Provider() = let AppendMemberData(xmlCollector: ITaggedTextCollector, exnCollector: ITaggedTextCollector, xmlDocReader: XmlDocReader, showExceptions, showParameters) = AppendHardLine xmlCollector xmlCollector.StartXMLDoc() @@ -270,14 +360,7 @@ module internal XmlDocumentation = paramName:string option ) = try - match GetMemberIndexOfAssembly(filename) with - | Some(index) -> - let _,idx = index.ParseMemberSignature(signature) - if idx <> 0u then - let ok,xml = index.GetMemberXML(idx) - if Com.Succeeded(ok) then - (this:>IDocumentationBuilder).AppendDocumentationFromProcessedXML(xmlCollector, exnCollector, xml, showExceptions, showParameters, paramName) - | None -> () + (this:>IDocumentationBuilder).AppendDocumentationFromProcessedXML(xmlCollector, exnCollector, FSharpXmlDocumentationProvider(filename).GetDocumentation(signature), showExceptions, showParameters, paramName) with e-> Assert.Exception(e) reraise() @@ -286,7 +369,7 @@ module internal XmlDocumentation = let AppendXmlComment(documentationProvider:IDocumentationBuilder, xmlCollector: ITaggedTextCollector, exnCollector: ITaggedTextCollector, xml, showExceptions, showParameters, paramName) = match xml with | FSharpXmlDoc.None -> () - | FSharpXmlDoc.XmlDocFileSignature(filename,signature) -> + | FSharpXmlDoc.XmlDocFileSignature(filename,signature) -> documentationProvider.AppendDocumentation(xmlCollector, exnCollector, filename, signature, showExceptions, showParameters, paramName) | FSharpXmlDoc.Text(rawXml) -> let processedXml = ProcessXml(rawXml) @@ -381,6 +464,7 @@ module internal XmlDocumentation = let BuildMethodParamText(documentationProvider, xmlCollector, xml, paramName) = AppendXmlComment(documentationProvider, TextSanitizingCollector(xmlCollector), TextSanitizingCollector(xmlCollector), xml, false, true, Some paramName) - let documentationBuilderCache = ConditionalWeakTable() - let CreateDocumentationBuilder(xmlIndexService: IVsXMLMemberIndexService) = - documentationBuilderCache.GetValue(xmlIndexService,(fun _ -> Provider(xmlIndexService) :> IDocumentationBuilder)) \ No newline at end of file + //let documentationBuilderCache = ConditionalWeakTable() + let CreateDocumentationBuilder((*xmlIndexService: IVsXMLMemberIndexService*)) = + //documentationBuilderCache.GetValue(xmlIndexService,(fun _ -> Provider((*xmlIndexService*)) :> IDocumentationBuilder)) + Provider((*xmlIndexService*)) :> IDocumentationBuilder \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.Designer.fs b/vsintegration/src/FSharp.Editor/FSharp.Editor.Designer.fs new file mode 100644 index 00000000000..18eedbf7541 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.Designer.fs @@ -0,0 +1,157 @@ + + +namespace FSharp.Editor +open System +open System.Reflection + +[] +type FSharp_Editor() = + [] + static val mutable private resourceMan:System.Resources.ResourceManager + + [] + static val mutable private resourceCulture:System.Globalization.CultureInfo + [] + member this.ResourceManager + with get() : System.Resources.ResourceManager = + if System.Object.Equals((Unchecked.defaultof<_>), FSharp_Editor.resourceMan) then + let mutable (temp:System.Resources.ResourceManager) = new System.Resources.ResourceManager("FSharp.Editor.resx", (typeof).Assembly) + FSharp_Editor.resourceMan <- temp + ((FSharp_Editor.resourceMan :> obj) :?> System.Resources.ResourceManager) + + [] + member this.Culture + with get() : System.Globalization.CultureInfo = + ((FSharp_Editor.resourceCulture :> obj) :?> System.Globalization.CultureInfo) + and set(value:System.Globalization.CultureInfo) : unit = + FSharp_Editor.resourceCulture <- value + + member this.AddNewKeyword + with get() : string = + FSharp_Editor.ResourceManager.GetString("AddNewKeyword", FSharp_Editor.resourceCulture) + + member this.ImplementInterface + with get() : string = + FSharp_Editor.ResourceManager.GetString("ImplementInterface", FSharp_Editor.resourceCulture) + + member this.ImplementInterfaceWithoutTypeAnnotation + with get() : string = + FSharp_Editor.ResourceManager.GetString("ImplementInterfaceWithoutTypeAnnotation", FSharp_Editor.resourceCulture) + + member this.PrefixValueNameWithUnderscore + with get() : string = + FSharp_Editor.ResourceManager.GetString("PrefixValueNameWithUnderscore", FSharp_Editor.resourceCulture) + + member this.RenameValueToUnderscore + with get() : string = + FSharp_Editor.ResourceManager.GetString("RenameValueToUnderscore", FSharp_Editor.resourceCulture) + + member this.SimplifyName + with get() : string = + FSharp_Editor.ResourceManager.GetString("SimplifyName", FSharp_Editor.resourceCulture) + + member this.NameCanBeSimplified + with get() : string = + FSharp_Editor.ResourceManager.GetString("NameCanBeSimplified", FSharp_Editor.resourceCulture) + + member this.FSharpFunctionsOrMethodsClassificationType + with get() : string = + FSharp_Editor.ResourceManager.GetString("FSharpFunctionsOrMethodsClassificationType", FSharp_Editor.resourceCulture) + + member this.FSharpMutableVarsClassificationType + with get() : string = + FSharp_Editor.ResourceManager.GetString("FSharpMutableVarsClassificationType", FSharp_Editor.resourceCulture) + + member this.FSharpPrintfFormatClassificationType + with get() : string = + FSharp_Editor.ResourceManager.GetString("FSharpPrintfFormatClassificationType", FSharp_Editor.resourceCulture) + + member this.FSharpPropertiesClassificationType + with get() : string = + FSharp_Editor.ResourceManager.GetString("FSharpPropertiesClassificationType", FSharp_Editor.resourceCulture) + + member this.FSharpDisposablesClassificationType + with get() : string = + FSharp_Editor.ResourceManager.GetString("FSharpDisposablesClassificationType", FSharp_Editor.resourceCulture) + + member this.RemoveUnusedOpens + with get() : string = + FSharp_Editor.ResourceManager.GetString("RemoveUnusedOpens", FSharp_Editor.resourceCulture) + + member this.UnusedOpens + with get() : string = + FSharp_Editor.ResourceManager.GetString("UnusedOpens", FSharp_Editor.resourceCulture) + + //member this.6008 + // with get() : string = + // FSharp_Editor.ResourceManager.GetString("6008", FSharp_Editor.resourceCulture) + + //member this.6009 + //with get() : string = + //FSharp_Editor.ResourceManager.GetString("6009", FSharp_Editor.resourceCulture) + + member this.AddAssemblyReference + with get() : string = + FSharp_Editor.ResourceManager.GetString("AddAssemblyReference", FSharp_Editor.resourceCulture) + + member this.AddProjectReference + with get() : string = + FSharp_Editor.ResourceManager.GetString("AddProjectReference", FSharp_Editor.resourceCulture) + + //member this.6010 + // with get() : string = + // FSharp_Editor.ResourceManager.GetString("6010", FSharp_Editor.resourceCulture) + + //member this.6011 + // with get() : string = + // FSharp_Editor.ResourceManager.GetString("6011", FSharp_Editor.resourceCulture) + + //member this.6012 + // with get() : string = + // FSharp_Editor.ResourceManager.GetString("6012", FSharp_Editor.resourceCulture) + + //member this.6013 + // with get() : string = + // FSharp_Editor.ResourceManager.GetString("6013", FSharp_Editor.resourceCulture) + + //member this.6014 + //with get() : string = + //FSharp_Editor.ResourceManager.GetString("6014", FSharp_Editor.resourceCulture) + + member this.TheValueIsUnused + with get() : string = + FSharp_Editor.ResourceManager.GetString("TheValueIsUnused", FSharp_Editor.resourceCulture) + + member this.CannotDetermineSymbol + with get() : string = + FSharp_Editor.ResourceManager.GetString("CannotDetermineSymbol", FSharp_Editor.resourceCulture) + + member this.CannotNavigateUnknown + with get() : string = + FSharp_Editor.ResourceManager.GetString("CannotNavigateUnknown", FSharp_Editor.resourceCulture) + + member this.LocatingSymbol + with get() : string = + FSharp_Editor.ResourceManager.GetString("LocatingSymbol", FSharp_Editor.resourceCulture) + + member this.NavigatingTo + with get() : string = + FSharp_Editor.ResourceManager.GetString("NavigatingTo", FSharp_Editor.resourceCulture) + + member this.NavigateToFailed + with get() : string = + FSharp_Editor.ResourceManager.GetString("NavigateToFailed", FSharp_Editor.resourceCulture) + + member this.ExceptionsHeader + with get() : string = + FSharp_Editor.ResourceManager.GetString("ExceptionsHeader", FSharp_Editor.resourceCulture) + + member this.GenericParametersHeader + with get() : string = + FSharp_Editor.ResourceManager.GetString("GenericParametersHeader", FSharp_Editor.resourceCulture) + + member this.RenameValueToDoubleUnderscore + with get() : string = + FSharp_Editor.ResourceManager.GetString("RenameValueToDoubleUnderscore", FSharp_Editor.resourceCulture) \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.Win.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.Win.fsproj new file mode 100644 index 00000000000..c295b354650 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.Win.fsproj @@ -0,0 +1,219 @@ + + + Library + $(NoWarn);75 + $(NoWarn);44 + + true + true + $(SystemValueTupleVersion) + $(OtherFlags) --warnon:1182 --subsystemversion:6.00 + false + net472 + + + embedded + false + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor + 0 + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor\FSharp.Editor.XML + false + + + portable + false + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor + 3 + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor\FSharp.Editor.XML + false + --warnon:11111182 --subsystemversion:6.00 --simpleresolution --nocopyfsharpcore + + + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor + 4 + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor\FSharp.Editor.XML + false + + + ..\..\..\..\monodevelop\main\build\AddIns\FSharp.Editor + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + FSharp.Editor + $(VSAssemblyVersion) + $PackageFolder$\FSharp.Editor.dll + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + FSharp.Editor.resx + + + + + + + + + + + + true + Microsoft.VisualStudio.FSharp.Editor.SR + PublicResXFileCodeGenerator + FSharp.Editor.Designer.fs + + + + + + + + + + + + + + + + + + + + + + + + + Common\LspExternalAccess.fs + + + + + + + + + + + + + + + + + + + + diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 77add187654..42b3fd27859 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -1,30 +1,80 @@ - - - - + + + + + - Library - $(NoWarn);75 - $(NoWarn);44 - true - true - $(SystemValueTupleVersion) - $(OtherFlags) --warnon:1182 --subsystemversion:6.00 - false + Debug + AnyCPU + {4C10F8F9-3816-4647-BA6E-85F5DE39883B} + FSharp.Editor + FSharp.Editor + False + False + $(MDFrameworkVersion) + + --warnon:1182 + Program + true + $(MSBuildProjectDirectory)\..\..\..\build\bin\MonoDevelop.exe + $(MSBuildProjectDirectory)\..\..\..\build\bin + true + portable + true + ..\..\..\..\..\build\AddIns\FSharpBinding + 3 + ..\..\..\..\..\build\AddIns\FSharp.Editor\FSharp.Editor.XML + false + --warnon:11111182 --subsystemversion:6.00 --simpleresolution + true + --publicsign + ..\..\..\src\buildtools\keys\MSFT.snk + ..\..\..\..\..\build\AddIns\FSharp.Editor\FSharp.Editor.XML - + + true + ;RELEASE + true + true + false + false + false + false + false + + + false + false + false + false + false + + + + + - - - + + + + + + + + - - - true - Microsoft.VisualStudio.FSharp.Editor.SR - - + + + + + + ..\..\..\..\Xamarin.Mac.dll + False + + + + @@ -34,50 +84,68 @@ - - - Common\LspExternalAccess.fs - - + + + + + + + + + + - - - - - + + + + + - - + - - + + + - - LanguageService\JsonOptionConverter.fs - - + - + + + + + + + + + + + + + + + + + + + - - - - - - + + + + @@ -85,106 +153,127 @@ - + - - - - - - - - - - - - - - - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FSharp.Editor - $(VSAssemblyVersion) - $PackageFolder$\FSharp.Editor.dll - - - FSharp.UIResources - $(VSAssemblyVersion) - $PackageFolder$\FSharp.UIResources.dll - + + + + + + FSharp.Editor.resx + + + + + + + + + + + true + Microsoft.VisualStudio.FSharp.Editor.SR + PublicResXFileCodeGenerator + FSharp.Editor.Designer.fs + + + + + + + + {4EDEC7A0-782C-41F5-9640-AF4DCD487016} + Microsoft.CodeAnalysis.ExternalAccess.FSharp + + + {2C24D515-4A2C-445C-8419-C09231913CFA} + MonoDevelop.DesignerSupport + False + + + + {91DD5A2D-9FE3-4C3C-9253-876141874DAD} + Mono.Addins + + False + + + + + + {27096E7F-C91C-4AC6-B289-6897A701DF21} + MonoDevelop.Ide + + False + + + + + + {3F5B5BDA-69D5-441A-8142-AA25C998A997} + MonoDevelop.TextEditor + + False + + + {92494904-35FA-4DC9-BDE9-3A3E87AC49D3} + Xwt + + False + + + {2357AABD-08C7-4808-A495-8FF2D3CDFDB0} + MonoDevelop.Debugger + + + {7525BB88-6142-4A26-93B9-A30C6983390A} + MonoDevelop.Core + + False + + + {D6B7E899-542A-4EAB-8F06-E737657B29DE} + CoreUtility + CoreUtility + + + + + + + {AF5FEAD5-B50E-4F07-A274-32F23D5C504D} + MonoDevelop.FSharp.Shared + + + + + + + + + - - + + + + + + + + + + + + + \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.sln b/vsintegration/src/FSharp.Editor/FSharp.Editor.sln new file mode 100644 index 00000000000..381c69dad79 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.sln @@ -0,0 +1,33 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 15 +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Editor", "FSharp.Editor.fsproj", "{3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}" +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{4A2F4F15-F535-4A18-B36C-F1F9080B6794}" + ProjectSection(SolutionItems) = preProject + ..\Directory.Build.props = ..\Directory.Build.props + ..\..\..\FSharp.Profiles.props = ..\..\..\FSharp.Profiles.props + ..\..\..\FSharpBuild.Directory.Build.props = ..\..\..\FSharpBuild.Directory.Build.props + ..\..\..\global.json = ..\..\..\global.json + ..\..\..\NuGet.config = ..\..\..\NuGet.config + ..\..\..\restore.sh = ..\..\..\restore.sh + EndProjectSection +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Proto|Any CPU = Proto|Any CPU + DebugMac|Any CPU = DebugMac|Any CPU + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.Proto|Any CPU.ActiveCfg = Proto|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.Proto|Any CPU.Build.0 = Proto|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.DebugMac|Any CPU.ActiveCfg = DebugMac|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.DebugMac|Any CPU.Build.0 = DebugMac|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.Debug|Any CPU.Build.0 = Debug|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.Release|Any CPU.ActiveCfg = Release|Any CPU + {3F4888DE-589A-4DD6-84CC-DDBE6F87A72C}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection +EndGlobal diff --git a/vsintegration/src/FSharp.Editor/FSharp.addin.xml b/vsintegration/src/FSharp.Editor/FSharp.addin.xml new file mode 100644 index 00000000000..80e0659a514 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/FSharp.addin.xml @@ -0,0 +1,246 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Context menu for fsi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs b/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs index 4cc4b10c5a2..8033fca4d02 100644 --- a/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs +++ b/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs @@ -14,7 +14,7 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor open FSharp.Compiler.SourceCodeServices open System.Threading -open System.Windows.Forms +//open System.Windows.Forms [)>] type internal FSharpEditorFormattingService @@ -189,7 +189,7 @@ type internal FSharpEditorFormattingService |> RoslynHelpers.StartAsyncAsTask cancellationToken override this.GetFormattingChangesOnPasteAsync (document, span, cancellationToken) = - let currentClipboard = Clipboard.GetText() + let currentClipboard = System.Windows.Clipboard.GetDataObject().GetData(System.Windows.DataFormats.Text) :?> string this.OnPasteAsync (document, span, currentClipboard, cancellationToken) |> RoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs index 8791c558896..4af0a4a39a3 100644 --- a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs +++ b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs @@ -159,7 +159,6 @@ type internal InlineRenameService let! _, _, checkFileResults = checker.ParseAndCheckDocument(document, options, userOpName = userOpName) let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, symbol.Ident.idRange.EndColumn, textLine.Text.ToString(), symbol.FullIsland, userOpName=userOpName) let! declLoc = symbolUse.GetDeclarationLocation(document) - let! span = RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, symbolUse.RangeAlternate) let triggerSpan = Tokenizer.fixupSpan(sourceText, span) diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs index 8397825d71a..8a47e756048 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs @@ -12,7 +12,8 @@ open Microsoft.VisualStudio.FSharp.Editor open Microsoft.VisualStudio.LanguageServices open FSharp.NativeInterop open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Diagnostics - +open MonoDevelop.Ide +open MonoDevelop.Ide.TypeSystem #nowarn "9" // NativePtr.toNativeInt // Exposes FSharpChecker as MEF export @@ -21,31 +22,31 @@ type internal FSharpCheckerProvider [] ( analyzerService: IFSharpDiagnosticAnalyzerService, - [)>] workspace: VisualStudioWorkspace, settings: EditorOptions ) = + let workspace = IdeApp.TypeSystemService.Workspace :?> MonoDevelopWorkspace + let tryGetMetadataSnapshot (_path, _timeStamp) = - let tryGetMetadataSnapshot (path, timeStamp) = - try - let md = Microsoft.CodeAnalysis.ExternalAccess.FSharp.LanguageServices.FSharpVisualStudioWorkspaceExtensions.GetMetadata(workspace, path, timeStamp) - let amd = (md :?> AssemblyMetadata) - let mmd = amd.GetModules().[0] - let mmr = mmd.GetMetadataReader() + //try + // let md = Microsoft.CodeAnalysis.ExternalAccess.FSharp.LanguageServices.FSharpVisualStudioWorkspaceExtensions.GetMetadata(workspace, path, timeStamp) + // let amd = (md :?> AssemblyMetadata) + // let mmd = amd.GetModules().[0] + // let mmr = mmd.GetMetadataReader() - // "lifetime is timed to Metadata you got from the GetMetadata(...). As long as you hold it strongly, raw - // memory we got from metadata reader will be alive. Once you are done, just let everything go and - // let finalizer handle resource rather than calling Dispose from Metadata directly. It is shared metadata. - // You shouldn't dispose it directly." + // // "lifetime is timed to Metadata you got from the GetMetadata(...). As long as you hold it strongly, raw + // // memory we got from metadata reader will be alive. Once you are done, just let everything go and + // // let finalizer handle resource rather than calling Dispose from Metadata directly. It is shared metadata. + // // You shouldn't dispose it directly." - let objToHold = box md + // let objToHold = box md - // We don't expect any ilread WeakByteFile to be created when working in Visual Studio - Debug.Assert((FSharp.Compiler.AbstractIL.ILBinaryReader.GetStatistics().weakByteFileCount = 0), "Expected weakByteFileCount to be zero when using F# in Visual Studio. Was there a problem reading a .NET binary?") + // // We don't expect any ilread WeakByteFile to be created when working in Visual Studio + // Debug.Assert((FSharp.Compiler.AbstractIL.ILBinaryReader.GetStatistics().weakByteFileCount = 0), "Expected weakByteFileCount to be zero when using F# in Visual Studio. Was there a problem reading a .NET binary?") - Some (objToHold, NativePtr.toNativeInt mmr.MetadataPointer, mmr.MetadataLength) - with ex -> - // We catch all and let the backup routines in the F# compiler find the error - Assert.Exception(ex) + // Some (objToHold, NativePtr.toNativeInt mmr.MetadataPointer, mmr.MetadataLength) + //with ex -> + //// We catch all and let the backup routines in the F# compiler find the error + //Assert.Exception(ex) None @@ -57,7 +58,7 @@ type internal FSharpCheckerProvider keepAllBackgroundResolutions = false, // Enabling this would mean that if devenv.exe goes above 2.3GB we do a one-off downsize of the F# Compiler Service caches (* , MaxMemory = 2300 *) - legacyReferenceResolver=LegacyMSBuildReferenceResolver.getResolver(), + (*legacyReferenceResolver=LegacyMSBuildReferenceResolver.getResolver(),*) tryGetMetadataSnapshot = tryGetMetadataSnapshot) // This is one half of the bridge between the F# background builder and the Roslyn analysis engine. diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpContentType.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpContentType.fs new file mode 100644 index 00000000000..ebbe56199a6 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpContentType.fs @@ -0,0 +1,16 @@ +// Copyright (c) Microsoft. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +namespace Microsoft.CodeAnalysis.ExternalAccess.FSharp.Internal + +open System.ComponentModel.Composition +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor + +type FSharpContentTypeDefinitions() = + [] + [] + [] + member val FSharpSignatureHelpContentTypeDefinition: Microsoft.VisualStudio.Utilities.ContentTypeDefinition = null with get, set + + [] + [] + [] + member val FSharpFileExtension: Microsoft.VisualStudio.Utilities.FileExtensionToContentTypeDefinition = null with get, set \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs index 5a2c3eed966..3e3944cb83f 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpProjectOptionsManager.fs @@ -14,42 +14,13 @@ open FSharp.Compiler.SourceCodeServices open Microsoft.VisualStudio open Microsoft.VisualStudio.FSharp.Editor open Microsoft.VisualStudio.LanguageServices -open Microsoft.VisualStudio.LanguageServices.Implementation.ProjectSystem -open Microsoft.VisualStudio.Shell open System.Threading -open Microsoft.VisualStudio.Shell.Interop -open Microsoft.VisualStudio.LanguageServices.Implementation.TaskList -open Microsoft.CodeAnalysis.ExternalAccess.FSharp.LanguageServices +open MonoDevelop.FSharp +open MonoDevelop.Ide +open MonoDevelop.Ide.TypeSystem [] module private FSharpProjectOptionsHelpers = - - let mapCpsProjectToSite(project:Project, cpsCommandLineOptions: IDictionary) = - let sourcePaths, referencePaths, options = - match cpsCommandLineOptions.TryGetValue(project.Id) with - | true, (sourcePaths, options) -> sourcePaths, [||], options - | false, _ -> [||], [||], [||] - let mutable errorReporter = Unchecked.defaultof<_> - { - new IProjectSite with - member __.Description = project.Name - member __.CompilationSourceFiles = sourcePaths - member __.CompilationOptions = - Array.concat [options; referencePaths |> Array.map(fun r -> "-r:" + r)] - member __.CompilationReferences = referencePaths - member site.CompilationBinOutputPath = site.CompilationOptions |> Array.tryPick (fun s -> if s.StartsWith("-o:") then Some s.[3..] else None) - member __.ProjectFileName = project.FilePath - member __.AdviseProjectSiteChanges(_,_) = () - member __.AdviseProjectSiteCleaned(_,_) = () - member __.AdviseProjectSiteClosed(_,_) = () - member __.IsIncompleteTypeCheckEnvironment = false - member __.TargetFrameworkMoniker = "" - member __.ProjectGuid = project.Id.Id.ToString() - member __.LoadTime = System.DateTime.Now - member __.ProjectProvider = None - member __.BuildErrorReporter with get () = errorReporter and set (v) = errorReporter <- v - } - let hasProjectVersionChanged (oldProject: Project) (newProject: Project) = oldProject.Version <> newProject.Version @@ -80,13 +51,13 @@ type private FSharpProjectOptionsMessage = | ClearSingleFileOptionsCache of DocumentId [] -type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, settings: EditorOptions, _serviceProvider, checkerProvider: FSharpCheckerProvider) = +type private FSharpProjectOptionsReactor (settings: EditorOptions, checkerProvider: FSharpCheckerProvider) = let cancellationTokenSource = new CancellationTokenSource() // Hack to store command line options from HandleCommandLineChanges let cpsCommandLineOptions = ConcurrentDictionary() - let legacyProjectSites = ConcurrentDictionary() + //let legacyProjectSites = ConcurrentDictionary() let cache = Dictionary() let singleFileCache = Dictionary() @@ -100,7 +71,22 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set let! scriptProjectOptions, _ = checkerProvider.Checker.GetProjectOptionsFromScript(document.FilePath, sourceText.ToFSharpSourceText()) let projectOptions = if isScriptFile document.FilePath then - scriptProjectOptions + + if scriptProjectOptions.OtherOptions |> Seq.exists (fun s -> s.Contains("FSharp.Core.dll")) then scriptProjectOptions + else + // Add assemblies that may be missing in the standard assembly resolution + LoggingService.logDebug "LanguageService: GetScriptCheckerOptions: Adding missing core assemblies." + let dirs = FSharpEnvironment.getDefaultDirectories (None, FSharpTargetFramework.NET_4_5 ) + { scriptProjectOptions with + OtherOptions = + [| yield! scriptProjectOptions.OtherOptions + match FSharpEnvironment.resolveAssembly dirs "FSharp.Core" with + | Some fn -> yield String.Format ("-r:{0}", fn) + | None -> + LoggingService.logDebug "LanguageService: Resolution: FSharp.Core assembly resolution failed!" + match FSharpEnvironment.resolveAssembly dirs "FSharp.Compiler.Interactive.Settings" with + | Some fn -> yield String.Format ("-r:{0}", fn) + | None -> LoggingService.logDebug "LanguageService: Resolution: FSharp.Compiler.Interactive.Settings assembly resolution failed!" |]} else { ProjectFileName = document.FilePath @@ -116,7 +102,7 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set ExtraProjectInfo= None Stamp = Some(int64 (fileStamp.GetHashCode())) } - + checkerProvider.Checker.CheckProjectInBackground(projectOptions, userOpName="checkOptions") let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) @@ -133,16 +119,8 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set return Some(parsingOptions, projectOptions) } - let tryGetProjectSite (project: Project) = - // Cps - if cpsCommandLineOptions.ContainsKey project.Id then - Some (mapCpsProjectToSite(project, cpsCommandLineOptions)) - else - // Legacy - match legacyProjectSites.TryGetValue project.Id with - | true, site -> Some site - | _ -> None - + let mdLanguageService = new MonoDevelop.FSharp.LanguageService(checkerProvider.Checker, (fun (changedfile, _) -> ()), None) + let rec tryComputeOptions (project: Project) = async { let projectId = project.Id @@ -152,68 +130,23 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set // Because this code can be kicked off before the hack, HandleCommandLineChanges, occurs, // the command line options will not be available and we should bail if one of the project references does not give us anything. let mutable canBail = false - - let referencedProjects = ResizeArray() - - if settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences then - for projectReference in project.ProjectReferences do - let referencedProject = project.Solution.GetProject(projectReference.ProjectId) - if referencedProject.Language = FSharpConstants.FSharpLanguageName then - match! tryComputeOptions referencedProject with - | None -> canBail <- true - | Some(_, projectOptions) -> referencedProjects.Add(referencedProject.OutputFilePath, projectOptions) + let fsharpProject = MonoDevelop.Ide.IdeApp.TypeSystemService.GetMonoProject(project) :?> MonoDevelop.FSharp.FSharpProject + let! refs = fsharpProject.GetReferences(MonoDevelop.FSharp.CompilerArguments.getConfig()) |> Async.AwaitTask + canBail <- refs.Count = 0 if canBail then return None else - - match tryGetProjectSite project with - | None -> return None - | Some projectSite -> - - let otherOptions = - project.ProjectReferences - |> Seq.map (fun x -> "-r:" + project.Solution.GetProject(x.ProjectId).OutputFilePath) - |> Array.ofSeq - |> Array.append ( - project.MetadataReferences.OfType() - |> Seq.map (fun x -> "-r:" + x.FilePath) - |> Array.ofSeq - |> Array.append ( - // Clear any references from CompilationOptions. - // We get the references from Project.ProjectReferences/Project.MetadataReferences. - projectSite.CompilationOptions - |> Array.filter (fun x -> not (x.Contains("-r:"))) - ) - ) - - let projectOptions = - { - ProjectFileName = projectSite.ProjectFileName - ProjectId = Some(projectId.ToFSharpProjectIdString()) - SourceFiles = projectSite.CompilationSourceFiles - OtherOptions = otherOptions - ReferencedProjects = referencedProjects.ToArray() - IsIncompleteTypeCheckEnvironment = projectSite.IsIncompleteTypeCheckEnvironment - UseScriptResolutionRules = SourceFile.MustBeSingleFileProject (Path.GetFileName(project.FilePath)) - LoadTime = projectSite.LoadTime - UnresolvedReferences = None - OriginalLoadReferences = [] - ExtraProjectInfo= None - Stamp = Some(int64 (project.Version.GetHashCode())) - } - - // This can happen if we didn't receive the callback from HandleCommandLineChanges yet. - if Array.isEmpty projectOptions.SourceFiles then - return None - else - checkerProvider.Checker.InvalidateConfiguration(projectOptions, startBackgroundCompileIfAlreadySeen = false, userOpName = "computeOptions") - - let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) - - cache.[projectId] <- (project, parsingOptions, projectOptions) - - return Some(parsingOptions, projectOptions) + let projectOpts = mdLanguageService.GetProjectCheckerOptions(project.FilePath, [], refs) + return projectOpts |> Option.bind(fun opts -> + // This can happen if we didn't receive the callback from HandleCommandLineChanges yet. + if Array.isEmpty opts.SourceFiles then + None + else + checkerProvider.Checker.InvalidateConfiguration(opts, startBackgroundCompileIfAlreadySeen = false, userOpName = "computeOptions") + let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(opts) + cache.[projectId] <- (project, parsingOptions, opts) + Some(parsingOptions, opts)) | true, (oldProject, parsingOptions, projectOptions) -> if isProjectInvalidated oldProject project settings then @@ -232,9 +165,9 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set reply.Reply None else try - // For now, disallow miscellaneous workspace since we are using the hacky F# miscellaneous files project. if document.Project.Solution.Workspace.Kind = WorkspaceKind.MiscellaneousFiles then - reply.Reply None + let! options = tryComputeOptionsByFile document ct + reply.Reply options elif document.Project.Name = FSharpConstants.FSharpMiscellaneousFilesName then let! options = tryComputeOptionsByFile document ct reply.Reply options @@ -261,7 +194,6 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set | FSharpProjectOptionsMessage.ClearOptions(projectId) -> cache.Remove(projectId) |> ignore - legacyProjectSites.TryRemove(projectId) |> ignore | FSharpProjectOptionsMessage.ClearSingleFileOptionsCache(documentId) -> singleFileCache.Remove(documentId) |> ignore } @@ -283,8 +215,8 @@ type private FSharpProjectOptionsReactor (_workspace: VisualStudioWorkspace, set member __.SetCpsCommandLineOptions(projectId, sourcePaths, options) = cpsCommandLineOptions.[projectId] <- (sourcePaths, options) - member __.SetLegacyProjectSite (projectId, projectSite) = - legacyProjectSites.[projectId] <- projectSite + member __.SetLegacyProjectSite (projectId, projectSite) = () + //legacyProjectSites.[projectId] <- projectSite member __.TryGetCachedOptionsByProjectId(projectId) = match cache.TryGetValue(projectId) with @@ -307,18 +239,14 @@ type internal FSharpProjectOptionsManager [] ( checkerProvider: FSharpCheckerProvider, - [)>] workspace: VisualStudioWorkspace, - [)>] serviceProvider: System.IServiceProvider, settings: EditorOptions ) = - let projectDisplayNameOf projectFileName = - if String.IsNullOrWhiteSpace projectFileName then projectFileName - else Path.GetFileNameWithoutExtension projectFileName - - let reactor = new FSharpProjectOptionsReactor(workspace, settings, serviceProvider, checkerProvider) + let reactor = new FSharpProjectOptionsReactor(settings, checkerProvider) do + let workspace = IdeApp.TypeSystemService.Workspace + // We need to listen to this event for lifecycle purposes. workspace.WorkspaceChanged.Add(fun args -> match args.Kind with @@ -367,27 +295,4 @@ type internal FSharpProjectOptionsManager return result |> Option.map(fun (parsingOptions, _, projectOptions) -> parsingOptions, projectOptions) } - [] - /// This handles commandline change notifications from the Dotnet Project-system - /// Prior to VS 15.7 path contained path to project file, post 15.7 contains target binpath - /// binpath is more accurate because a project file can have multiple in memory projects based on configuration - member __.HandleCommandLineChanges(path:string, sources:ImmutableArray, _references:ImmutableArray, options:ImmutableArray) = - use _logBlock = Logger.LogBlock(LogEditorFunctionId.LanguageService_HandleCommandLineArgs) - - let projectId = - match Microsoft.CodeAnalysis.ExternalAccess.FSharp.LanguageServices.FSharpVisualStudioWorkspaceExtensions.TryGetProjectIdByBinPath(workspace, path) with - | true, projectId -> projectId - | false, _ -> Microsoft.CodeAnalysis.ExternalAccess.FSharp.LanguageServices.FSharpVisualStudioWorkspaceExtensions.GetOrCreateProjectIdForPath(workspace, path, projectDisplayNameOf path) - let path = Microsoft.CodeAnalysis.ExternalAccess.FSharp.LanguageServices.FSharpVisualStudioWorkspaceExtensions.GetProjectFilePath(workspace, projectId) - - let getFullPath p = - let p' = - if Path.IsPathRooted(p) || path = null then p - else Path.Combine(Path.GetDirectoryName(path), p) - Path.GetFullPathSafe(p') - - let sourcePaths = sources |> Seq.map(fun s -> getFullPath s.Path) |> Seq.toArray - - reactor.SetCpsCommandLineOptions(projectId, sourcePaths, options.ToArray()) - member __.Checker = checkerProvider.Checker diff --git a/vsintegration/src/FSharp.Editor/LanguageService/IProjectSite.fs b/vsintegration/src/FSharp.Editor/LanguageService/IProjectSite.fs deleted file mode 100644 index 0b3f65d3627..00000000000 --- a/vsintegration/src/FSharp.Editor/LanguageService/IProjectSite.fs +++ /dev/null @@ -1,61 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open System.Runtime.InteropServices - -/// Narrow abstraction over the project system. -type internal AdviseProjectSiteChanges = delegate of unit -> unit - -[] -type internal IProvideProjectSite = - abstract GetProjectSite : unit -> IProjectSite - -/// Represents known F#-specific information about a project. -and internal IProjectSite = - - /// List of files in the project. In the correct order. - abstract CompilationSourceFiles : string[] - - /// Flags that the compiler would need to understand how to compile. Includes '-r' - /// options but not source files - abstract CompilationOptions : string[] - - /// The normalized '-r:' assembly references, without the '-r:' - abstract CompilationReferences : string[] - - /// The '-o:' output bin path, without the '-o:' - abstract CompilationBinOutputPath : string option - - /// The name of the project file. - abstract ProjectFileName : string - - /// Register for notifications for when the above change - abstract AdviseProjectSiteChanges : callbackOwnerKey: string * AdviseProjectSiteChanges -> unit - - /// Register for notifications when project is cleaned/rebuilt (and thus any live TypeProviders should be refreshed) - abstract AdviseProjectSiteCleaned : callbackOwnerKey: string * AdviseProjectSiteChanges -> unit - - // Register for notifications when project is closed. - abstract AdviseProjectSiteClosed : callbackOwnerKey: string * AdviseProjectSiteChanges -> unit - - /// A user-friendly description of the project. Used only for developer/DEBUG tooltips and such. - abstract Description : string - - /// The error list task reporter - abstract BuildErrorReporter : Microsoft.VisualStudio.Shell.Interop.IVsLanguageServiceBuildErrorReporter2 option with get, set - - /// False type resolution errors are invalid. This occurs with orphaned source files. The prior - /// type checking state is unknown. In this case we don't want to squiggle the type checking files. - abstract IsIncompleteTypeCheckEnvironment : bool - - /// target framework moniker - abstract TargetFrameworkMoniker : string - - /// Project Guid - abstract ProjectGuid : string - - /// timestamp the site was last loaded - abstract LoadTime : System.DateTime - - abstract ProjectProvider : IProvideProjectSite option \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index f02f4e344b4..aee0e406fa7 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -3,24 +3,10 @@ namespace rec Microsoft.VisualStudio.FSharp.Editor open System -open System.ComponentModel.Design -open System.Runtime.InteropServices -open System.Threading -open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Options open FSharp.Compiler.SourceCodeServices -open FSharp.NativeInterop open Microsoft.VisualStudio open Microsoft.VisualStudio.FSharp.Editor -open Microsoft.VisualStudio.LanguageServices -open Microsoft.VisualStudio.LanguageServices.Implementation.LanguageService -open Microsoft.VisualStudio.LanguageServices.Implementation.ProjectSystem -open Microsoft.VisualStudio.LanguageServices.ProjectSystem -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop -open Microsoft.VisualStudio.Text.Outlining -open FSharp.NativeInterop -open Microsoft.CodeAnalysis.ExternalAccess.FSharp #nowarn "9" // NativePtr.toNativeInt @@ -57,191 +43,9 @@ type internal FSharpCheckerWorkspaceServiceFactory member __.Checker = checkerProvider.Checker member __.FSharpProjectOptionsManager = projectInfoManager } -[] -type private FSharpSolutionEvents(projectManager: FSharpProjectOptionsManager) = - - interface IVsSolutionEvents with - - member __.OnAfterCloseSolution(_) = - projectManager.Checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() - VSConstants.S_OK - - member __.OnAfterLoadProject(_, _) = VSConstants.E_NOTIMPL - - member __.OnAfterOpenProject(_, _) = VSConstants.E_NOTIMPL - - member __.OnAfterOpenSolution(_, _) = VSConstants.E_NOTIMPL - - member __.OnBeforeCloseProject(_, _) = VSConstants.E_NOTIMPL - - member __.OnBeforeCloseSolution(_) = VSConstants.E_NOTIMPL - - member __.OnBeforeUnloadProject(_, _) = VSConstants.E_NOTIMPL - - member __.OnQueryCloseProject(_, _, _) = VSConstants.E_NOTIMPL - - member __.OnQueryCloseSolution(_, _) = VSConstants.E_NOTIMPL - - member __.OnQueryUnloadProject(_, _) = VSConstants.E_NOTIMPL - [, Microsoft.CodeAnalysis.Host.Mef.ServiceLayer.Default)>] type internal FSharpSettingsFactory [] (settings: EditorOptions) = interface Microsoft.CodeAnalysis.Host.Mef.IWorkspaceServiceFactory with member __.CreateService(_) = upcast settings -[] -[, - "F# Tools", "F# Interactive", // category/sub-category on Tools>Options... - 6000s, 6001s, // resource id for localisation of the above - true)>] // true = supports automation -[] // <-- resource ID for localised name -[, - // The following should place the ToolWindow with the OutputWindow by default. - Orientation=ToolWindowOrientation.Bottom, - Style=VsDockStyle.Tabbed, - PositionX = 0, - PositionY = 0, - Width = 360, - Height = 120, - Window="34E76E81-EE4A-11D0-AE2E-00A0C90FFFC3")>] -[, "F#", null, "IntelliSense", "6008")>] -[, "F#", null, "QuickInfo", "6009")>] -[, "F#", null, "Code Fixes", "6010")>] -[, "F#", null, "Performance", "6011")>] -[, "F#", null, "Advanced", "6012")>] -[, "F#", null, "CodeLens", "6013")>] -[, "F#", null, "Formatting", "6014")>] -[] -// 64 represents a hex number. It needs to be greater than 37 so the TextMate editor will not be chosen as higher priority. -[, ".fs", 64)>] -[, ".fsi", 64)>] -[, ".fsscript", 64)>] -[, ".fsx", 64)>] -[, ".ml", 64)>] -[, ".mli", 64)>] -[, 101s, CommonPhysicalViewAttributes = Constants.FSharpEditorFactoryPhysicalViewAttributes)>] -[, ".fs")>] -[, ".fsi")>] -[, ".fsx")>] -[, ".fsscript")>] -[, ".ml")>] -[, ".mli")>] -[] -[, - strLanguageName = FSharpConstants.FSharpLanguageName, - languageResourceID = 100, - MatchBraces = true, - MatchBracesAtCaret = true, - ShowCompletion = true, - ShowMatchingBrace = true, - ShowSmartIndent = true, - EnableAsyncCompletion = true, - QuickInfo = true, - DefaultToInsertSpaces = true, - CodeSense = true, - DefaultToNonHotURLs = true, - RequestStockColors = true, - EnableCommenting = true, - CodeSenseDelay = 100, - ShowDropDownOptions = true)>] -type internal FSharpPackage() as this = - inherit AbstractPackage() - - let mutable vfsiToolWindow = Unchecked.defaultof - let GetToolWindowAsITestVFSI() = - if vfsiToolWindow = Unchecked.defaultof<_> then - vfsiToolWindow <- this.FindToolWindow(typeof, 0, true) :?> Microsoft.VisualStudio.FSharp.Interactive.FsiToolWindow - vfsiToolWindow :> Microsoft.VisualStudio.FSharp.Interactive.ITestVFSI - - let mutable solutionEventsOpt = None - - // FSI-LINKAGE-POINT: unsited init - do - Microsoft.VisualStudio.FSharp.Interactive.Hooks.fsiConsoleWindowPackageCtorUnsited (this :> Package) - - override this.InitializeAsync(cancellationToken: CancellationToken, progress: IProgress) : Tasks.Task = - // `base.` methods can't be called in the `async` builder, so we have to cache it - let baseInitializeAsync = base.InitializeAsync(cancellationToken, progress) - let task = - async { - do! baseInitializeAsync |> Async.AwaitTask - - let! commandService = this.GetServiceAsync(typeof) |> Async.AwaitTask // FSI-LINKAGE-POINT - let commandService = commandService :?> OleMenuCommandService - let packageInit () = - // FSI-LINKAGE-POINT: sited init - Microsoft.VisualStudio.FSharp.Interactive.Hooks.fsiConsoleWindowPackageInitalizeSited (this :> Package) commandService - - // FSI-LINKAGE-POINT: private method GetDialogPage forces fsi options to be loaded - let _fsiPropertyPage = this.GetDialogPage(typeof) - let projectInfoManager = this.ComponentModel.DefaultExportProvider.GetExport().Value - let solution = this.GetServiceAsync(typeof).Result - let solution = solution :?> IVsSolution - let solutionEvents = FSharpSolutionEvents(projectInfoManager) - let rdt = this.GetServiceAsync(typeof).Result - let rdt = rdt :?> IVsRunningDocumentTable - - solutionEventsOpt <- Some(solutionEvents) - solution.AdviseSolutionEvents(solutionEvents) |> ignore - - let projectContextFactory = this.ComponentModel.GetService() - let workspace = this.ComponentModel.GetService() - let miscFilesWorkspace = this.ComponentModel.GetService() - let _singleFileWorkspaceMap = new SingleFileWorkspaceMap(workspace, miscFilesWorkspace, projectInfoManager, projectContextFactory, rdt) - let _legacyProjectWorkspaceMap = new LegacyProjectWorkspaceMap(solution, projectInfoManager, projectContextFactory) - () - let awaiter = this.JoinableTaskFactory.SwitchToMainThreadAsync().GetAwaiter() - if awaiter.IsCompleted then - packageInit() // already on the UI thread - else - awaiter.OnCompleted(fun () -> packageInit()) - - } |> Async.StartAsTask - upcast task // convert Task to Task - - override this.RoslynLanguageName = FSharpConstants.FSharpLanguageName - override this.CreateWorkspace() = this.ComponentModel.GetService() - override this.CreateLanguageService() = FSharpLanguageService(this) - override this.CreateEditorFactories() = seq { yield FSharpEditorFactory(this) :> IVsEditorFactory } - override this.RegisterMiscellaneousFilesWorkspaceInformation(miscFilesWorkspace) = - miscFilesWorkspace.RegisterLanguage(Guid(FSharpConstants.languageServiceGuidString), FSharpConstants.FSharpLanguageName, ".fsx") - - interface Microsoft.VisualStudio.FSharp.Interactive.ITestVFSI with - member this.SendTextInteraction(s:string) = - GetToolWindowAsITestVFSI().SendTextInteraction(s) - member this.GetMostRecentLines(n:int) : string[] = - GetToolWindowAsITestVFSI().GetMostRecentLines(n) - -[] -type internal FSharpLanguageService(package : FSharpPackage) = - inherit AbstractLanguageService(package) - - override this.Initialize() = - base.Initialize() - - this.Workspace.Options <- this.Workspace.Options.WithChangedOption(Completion.FSharpCompletionOptions.BlockForCompletionItems, FSharpConstants.FSharpLanguageName, false) - this.Workspace.Options <- this.Workspace.Options.WithChangedOption(Shared.Options.FSharpServiceFeatureOnOffOptions.ClosedFileDiagnostic, FSharpConstants.FSharpLanguageName, Nullable false) - - let theme = package.ComponentModel.DefaultExportProvider.GetExport().Value - theme.SetColors() - - override __.ContentTypeName = FSharpConstants.FSharpContentTypeName - override __.LanguageName = FSharpConstants.FSharpLanguageName - override __.RoslynLanguageName = FSharpConstants.FSharpLanguageName - - override __.LanguageServiceId = new Guid(FSharpConstants.languageServiceGuidString) - override __.DebuggerLanguageId = DebuggerEnvironment.GetLanguageID() - - override __.CreateContext(_,_,_,_,_) = raise(System.NotImplementedException()) - - override this.SetupNewTextView(textView) = - base.SetupNewTextView(textView) - - // Toggles outlining (or code folding) based on settings - let outliningManagerService = this.Package.ComponentModel.GetService() - let wpfTextView = this.EditorAdaptersFactoryService.GetWpfTextView(textView) - let outliningManager = outliningManagerService.GetOutliningManager(wpfTextView) - if not (isNull outliningManager) then - let settings = this.Workspace.Services.GetService() - outliningManager.Enabled <- settings.Advanced.IsOutliningEnabled diff --git a/vsintegration/src/FSharp.Editor/LanguageService/Symbols.fs b/vsintegration/src/FSharp.Editor/LanguageService/Symbols.fs index a3d9b784526..3632b661bf4 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/Symbols.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/Symbols.fs @@ -16,7 +16,6 @@ open FSharp.Compiler.Ast open FSharp.Compiler.SourceCodeServices open System.IO - [] type SymbolDeclarationLocation = | CurrentDocument diff --git a/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs b/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs index e45e28a19d0..e5be644fc62 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs @@ -441,7 +441,7 @@ module internal Tokenizer = let compilerTokenToRoslynToken(colorKind: FSharpTokenColorKind) : string = match colorKind with | FSharpTokenColorKind.Comment -> ClassificationTypeNames.Comment - | FSharpTokenColorKind.Identifier -> ClassificationTypeNames.Identifier + | FSharpTokenColorKind.Identifier -> ClassificationTypeNames.LocalName | FSharpTokenColorKind.Keyword -> ClassificationTypeNames.Keyword | FSharpTokenColorKind.String -> ClassificationTypeNames.StringLiteral | FSharpTokenColorKind.Text -> ClassificationTypeNames.Text diff --git a/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs b/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs index f33d23b3291..0cf43dc2d44 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs @@ -2,9 +2,7 @@ namespace Microsoft.VisualStudio.FSharp.Editor -open System.Threading open System.Collections.Immutable -open System.Composition open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.ExternalAccess.FSharp @@ -14,6 +12,8 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor.FindUsages open FSharp.Compiler.Range open FSharp.Compiler.SourceCodeServices +open System.ComponentModel.Composition; + [)>] type internal FSharpFindUsagesService [] @@ -133,4 +133,3 @@ type internal FSharpFindUsagesService member __.FindImplementationsAsync(document, position, context) = findReferencedSymbolsAsync(document, position, context, false, userOpName) |> RoslynHelpers.StartAsyncUnitAsTask(context.CancellationToken) - \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs index a607442e462..073365a823d 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs @@ -16,8 +16,6 @@ open Microsoft.CodeAnalysis.Text open Microsoft.CodeAnalysis.Navigation open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Navigation -open Microsoft.VisualStudio.Shell.Interop - open FSharp.Compiler.Range open FSharp.Compiler.SourceCodeServices @@ -107,40 +105,22 @@ module private ExternalSymbol = | _ -> [] // TODO: Uncomment code when VS has a fix for updating the status bar. -type internal StatusBar(statusBar: IVsStatusbar) = - let mutable _searchIcon = int16 Microsoft.VisualStudio.Shell.Interop.Constants.SBAI_Find :> obj - - let _clear() = - // unfreeze the statusbar - statusBar.FreezeOutput 0 |> ignore - statusBar.Clear() |> ignore - - member __.Message(_msg: string) = - () - //let _, frozen = statusBar.IsFrozen() - //// unfreeze the status bar - //if frozen <> 0 then statusBar.FreezeOutput 0 |> ignore - //statusBar.SetText msg |> ignore - //// freeze the status bar - //statusBar.FreezeOutput 1 |> ignore - - member this.TempMessage(_msg: string) = - () - //this.Message msg - //async { - // do! Async.Sleep 4000 - // match statusBar.GetText() with - // | 0, currentText when currentText <> msg -> () - // | _ -> clear() - //}|> Async.Start - - member __.Clear() = () //clear() +type internal StatusBar() = + let clear() = + MonoDevelop.Ide.IdeApp.Workbench.StatusBar.ShowReady() + + member __.Message(msg: string) = + MonoDevelop.Ide.IdeApp.Workbench.StatusBar.ShowMessage(msg) + + member this.TempMessage(msg: string) = + this.Message(msg) + + member __.Clear() = clear() /// Animated magnifying glass that displays on the status bar while a symbol search is in progress. member __.Animate() : IDisposable = - //statusBar.Animation (1, &searchIcon) |> ignore { new IDisposable with - member __.Dispose() = () } //statusBar.Animation(0, &searchIcon) |> ignore } + member __.Dispose() = () } type internal FSharpGoToDefinitionNavigableItem(document, sourceSpan) = inherit FSharpNavigableItem(Glyph.BasicFile, ImmutableArray.Empty, document, sourceSpan) @@ -218,7 +198,7 @@ type internal GoToDefinition(checker: FSharpChecker, projectInfoManager: FSharpP return implSymbol.RangeAlternate } - member private this.FindDefinitionAtPosition(originDocument: Document, position: int) = + member this.FindDefinitionAtPosition(originDocument: Document, position: int) = asyncMaybe { let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(originDocument, CancellationToken.None) let! sourceText = originDocument.GetTextAsync () |> liftTaskAsync diff --git a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs index 1a5b1e611ec..11891f95b47 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs @@ -2,18 +2,12 @@ namespace Microsoft.VisualStudio.FSharp.Editor -open System.Composition open System.Threading -open System.Threading.Tasks open Microsoft.CodeAnalysis -open Microsoft.CodeAnalysis.Editor -open Microsoft.CodeAnalysis.Host.Mef open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop -open System +open System.ComponentModel.Composition; [)>] [)>] @@ -25,7 +19,7 @@ type internal FSharpGoToDefinitionService ) = let gtd = GoToDefinition(checkerProvider.Checker, projectInfoManager) - let statusBar = StatusBar(ServiceProvider.GlobalProvider.GetService()) + let statusBar = StatusBar() interface IFSharpGoToDefinitionService with /// Invoked with Peek Definition. @@ -35,28 +29,19 @@ type internal FSharpGoToDefinitionService /// Invoked with Go to Definition. /// Try to navigate to the definiton of the symbol at the symbolRange in the originDocument member __.TryGoToDefinition(document: Document, position: int, cancellationToken: CancellationToken) = - statusBar.Message(SR.LocatingSymbol()) - use __ = statusBar.Animate() - - let gtdTask = gtd.FindDefinitionTask(document, position, cancellationToken) - - // Wrap this in a try/with as if the user clicks "Cancel" on the thread dialog, we'll be cancelled. - // Task.Wait throws an exception if the task is cancelled, so be sure to catch it. - try - // This call to Wait() is fine because we want to be able to provide the error message in the status bar. - gtdTask.Wait() - if gtdTask.Status = TaskStatus.RanToCompletion && gtdTask.Result.IsSome then - let item, _ = gtdTask.Result.Value - gtd.NavigateToItem(item, statusBar) - - // 'true' means do it, like Sheev Palpatine would want us to. - true - else - statusBar.TempMessage (SR.CannotDetermineSymbol()) - false - with exc -> - statusBar.TempMessage(String.Format(SR.NavigateToFailed(), Exception.flattenMessage exc)) - - // Don't show the dialog box as it's most likely that the user cancelled. - // Don't make them click twice. - true \ No newline at end of file + let computation = + async { + + statusBar.Message(SR.LocatingSymbol()) + use __ = statusBar.Animate() + + let! position = gtd.FindDefinitionAtPosition(document, position) + + match position with + | Some (item, _) -> + gtd.NavigateToItem(item, statusBar) + | None -> + statusBar.TempMessage (SR.CannotDetermineSymbol()) + } + Async.StartImmediate(computation, cancellationToken) + true \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Navigation/NavigableSymbolsService.fs b/vsintegration/src/FSharp.Editor/Navigation/NavigableSymbolsService.fs index a1022788ab6..9889796f89d 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/NavigableSymbolsService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/NavigableSymbolsService.fs @@ -2,21 +2,18 @@ namespace Microsoft.VisualStudio.FSharp.Editor -open System open System.Threading open System.Threading.Tasks open System.ComponentModel.Composition open Microsoft.CodeAnalysis.Text -open Microsoft.CodeAnalysis.Navigation open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Navigation open Microsoft.VisualStudio.Language.Intellisense open Microsoft.VisualStudio.Text open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.Shell.Interop -open Microsoft.VisualStudio.Utilities -open Microsoft.VisualStudio.Shell + +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor [] type internal FSharpNavigableSymbol(item: FSharpNavigableItem, span: SnapshotSpan, gtd: GoToDefinition, statusBar: StatusBar) = @@ -28,11 +25,11 @@ type internal FSharpNavigableSymbol(item: FSharpNavigableItem, span: SnapshotSpa member __.SymbolSpan = span -type internal FSharpNavigableSymbolSource(checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, serviceProvider: IServiceProvider) = +type internal FSharpNavigableSymbolSource(checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager(*, serviceProvider: IServiceProvider*)) = let mutable disposed = false let gtd = GoToDefinition(checkerProvider.Checker, projectInfoManager) - let statusBar = StatusBar(serviceProvider.GetService()) + let statusBar = StatusBar() interface INavigableSymbolSource with member __.GetNavigableSymbolAsync(triggerSpan: SnapshotSpan, cancellationToken: CancellationToken) = @@ -44,9 +41,6 @@ type internal FSharpNavigableSymbolSource(checkerProvider: FSharpCheckerProvider let position = triggerSpan.Start.Position let document = snapshot.GetOpenDocumentInCurrentContextWithChanges() let! sourceText = document.GetTextAsync() |> liftTaskAsync - - statusBar.Message(SR.LocatingSymbol()) - use _ = statusBar.Animate() let gtdTask = gtd.FindDefinitionTask(document, position, cancellationToken) @@ -55,7 +49,6 @@ type internal FSharpNavigableSymbolSource(checkerProvider: FSharpCheckerProvider try // This call to Wait() is fine because we want to be able to provide the error message in the status bar. gtdTask.Wait() - statusBar.Clear() if gtdTask.Status = TaskStatus.RanToCompletion && gtdTask.Result.IsSome then let navigableItem, range = gtdTask.Result.Value @@ -66,14 +59,8 @@ type internal FSharpNavigableSymbolSource(checkerProvider: FSharpCheckerProvider return FSharpNavigableSymbol(navigableItem, symbolSpan, gtd, statusBar) :> INavigableSymbol else - statusBar.TempMessage(SR.CannotDetermineSymbol()) - - // The NavigableSymbols API accepts 'null' when there's nothing to navigate to. return null with exc -> - statusBar.TempMessage(String.Format(SR.NavigateToFailed(), Exception.flattenMessage exc)) - - // The NavigableSymbols API accepts 'null' when there's nothing to navigate to. return null } |> Async.map Option.toObj @@ -83,17 +70,16 @@ type internal FSharpNavigableSymbolSource(checkerProvider: FSharpCheckerProvider disposed <- true [)>] -[] -[] -[] +[] +[] +[] type internal FSharpNavigableSymbolService [] ( - [)>] serviceProvider: IServiceProvider, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager ) = interface INavigableSymbolSourceProvider with member __.TryCreateNavigableSymbolSource(_: ITextView, _: ITextBuffer) = - new FSharpNavigableSymbolSource(checkerProvider, projectInfoManager, serviceProvider) :> INavigableSymbolSource \ No newline at end of file + new FSharpNavigableSymbolSource(checkerProvider, projectInfoManager) :> INavigableSymbolSource \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs b/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs index 428ca48ef62..3454a5bcc32 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs @@ -7,18 +7,12 @@ open System.IO open System.Composition open System.Collections.Generic open System.Collections.Immutable -open System.Threading open System.Threading.Tasks -open System.Runtime.CompilerServices open System.Runtime.Caching open System.Globalization open Microsoft.CodeAnalysis -open Microsoft.CodeAnalysis.Host.Mef open Microsoft.CodeAnalysis.Text -open Microsoft.CodeAnalysis.NavigateTo -open Microsoft.CodeAnalysis.Navigation -open Microsoft.CodeAnalysis.PatternMatching open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Navigation open Microsoft.CodeAnalysis.ExternalAccess.FSharp.NavigateTo @@ -218,40 +212,40 @@ type internal FSharpNavigateToSearchService itemsByDocumentId.Set(cacheItem, policy) return indexedItems } - let patternMatchKindToNavigateToMatchKind = function - | PatternMatchKind.Exact -> FSharpNavigateToMatchKind.Exact - | PatternMatchKind.Prefix -> FSharpNavigateToMatchKind.Prefix - | PatternMatchKind.Substring -> FSharpNavigateToMatchKind.Substring - | PatternMatchKind.CamelCase -> FSharpNavigateToMatchKind.Regular - | PatternMatchKind.Fuzzy -> FSharpNavigateToMatchKind.Regular + let _patternMatchKindToNavigateToMatchKind = function + //| PatternMatchKind.Exact -> FSharpNavigateToMatchKind.Exact + //| PatternMatchKind.Prefix -> FSharpNavigateToMatchKind.Prefix + //| PatternMatchKind.Substring -> FSharpNavigateToMatchKind.Substring + //| PatternMatchKind.CamelCase -> FSharpNavigateToMatchKind.Regular + //| PatternMatchKind.Fuzzy -> FSharpNavigateToMatchKind.Regular | _ -> FSharpNavigateToMatchKind.Regular interface IFSharpNavigateToSearchService with - member __.SearchProjectAsync(project, _priorityDocuments, searchPattern, kinds, cancellationToken) : Task> = + member __.SearchProjectAsync(project, _priorityDocuments, _searchPattern, kinds, cancellationToken) : Task> = asyncMaybe { let! parsingOptions, _options = projectInfoManager.TryGetOptionsByProject(project, cancellationToken) - let! items = + let! _items = project.Documents |> Seq.map (fun document -> getCachedIndexedNavigableItems(document, parsingOptions, kinds)) |> Async.Parallel |> liftAsync - - let items = - if searchPattern.Length = 1 then - items - |> Array.map (fun items -> items.Find(searchPattern)) - |> Array.concat - |> Array.filter (fun x -> x.Name.Length = 1 && String.Equals(x.Name, searchPattern, StringComparison.InvariantCultureIgnoreCase)) - else - [| yield! items |> Array.map (fun items -> items.Find(searchPattern)) |> Array.concat - use patternMatcher = new PatternMatcher(searchPattern, allowFuzzyMatching = true) - yield! items - |> Array.collect (fun item -> item.AllItems) - |> Array.Parallel.collect (fun x -> - patternMatcher.GetMatches(x.Name) - |> Seq.map (fun pm -> - NavigateToSearchResult(x, patternMatchKindToNavigateToMatchKind pm.Kind) :> FSharpNavigateToSearchResult) - |> Seq.toArray) |] + + let items = Array.Empty() + //if searchPattern.Length = 1 then + // items + // |> Array.map (fun items -> items.Find(searchPattern)) + // |> Array.concat + // |> Array.filter (fun x -> x.Name.Length = 1 && String.Equals(x.Name, searchPattern, StringComparison.InvariantCultureIgnoreCase)) + //else + //[| yield! items |> Array.map (fun items -> items.Find(searchPattern)) |> Array.concat + //use patternMatcher = new PatternMatcher(searchPattern, allowFuzzyMatching = true) + //yield! items + //|> Array.collect (fun item -> item.AllItems) + //|> Array.Parallel.collect (fun x -> + //patternMatcher.GetMatches(x.Name) + //|> Seq.map (fun pm -> + // NavigateToSearchResult(x, patternMatchKindToNavigateToMatchKind pm.Kind) :> FSharpNavigateToSearchResult) + //|> Seq.toArray) |] return items |> Array.distinctBy (fun x -> x.NavigableItem.Document.Id, x.NavigableItem.SourceSpan) } diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptionsMac.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptionsMac.fs new file mode 100644 index 00000000000..979bcc0dab1 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptionsMac.fs @@ -0,0 +1,144 @@ +namespace Microsoft.VisualStudio.FSharp.Editor +open System +open System.ComponentModel.Composition + +module DefaultTuning = + let UnusedDeclarationsAnalyzerInitialDelay = 0 (* 1000 *) (* milliseconds *) + let UnusedOpensAnalyzerInitialDelay = 0 (* 2000 *) (* milliseconds *) + let SimplifyNameInitialDelay = 2000 (* milliseconds *) + let SimplifyNameEachItemDelay = 0 (* milliseconds *) + + /// How long is the per-document data saved before it is eligible for eviction from the cache? 10 seconds. + /// Re-tokenizing is fast so we don't need to save this data long. + let PerDocumentSavedDataSlidingWindow = TimeSpan(0,0,10)(* seconds *) + +type EnterKeySetting = + | NeverNewline + | NewlineOnCompleteWord + | AlwaysNewline + +// CLIMutable to make the record work also as a view model +[] +type IntelliSenseOptions = + { ShowAfterCharIsTyped: bool + ShowAfterCharIsDeleted: bool + IncludeSymbolsFromUnopenedNamespacesOrModules : bool + EnterKeySetting : EnterKeySetting } + static member Default = + { ShowAfterCharIsTyped = true + ShowAfterCharIsDeleted = false + IncludeSymbolsFromUnopenedNamespacesOrModules = false + EnterKeySetting = EnterKeySetting.NeverNewline} + + +[] +type QuickInfoUnderlineStyle = Dot | Dash | Solid + +[] +type QuickInfoOptions = + { DisplayLinks: bool + UnderlineStyle: QuickInfoUnderlineStyle } + static member Default = + { DisplayLinks = true + UnderlineStyle = QuickInfoUnderlineStyle.Solid } + +[] +type CodeFixesOptions = + { SimplifyName: bool + AlwaysPlaceOpensAtTopLevel: bool + UnusedOpens: bool + UnusedDeclarations: bool + SuggestNamesForErrors: bool } + static member Default = + { // We have this off by default, disable until we work out how to make this low priority + // See https://github.com/Microsoft/visualfsharp/pull/3238#issue-237699595 + SimplifyName = false + AlwaysPlaceOpensAtTopLevel = true + UnusedOpens = true + UnusedDeclarations = true + SuggestNamesForErrors = true } + +[] +type LanguageServicePerformanceOptions = + { EnableInMemoryCrossProjectReferences: bool + AllowStaleCompletionResults: bool + TimeUntilStaleCompletion: int + ProjectCheckCacheSize: int } + static member Default = + { EnableInMemoryCrossProjectReferences = false + AllowStaleCompletionResults = true + TimeUntilStaleCompletion = 2000 // In ms, so this is 2 seconds + ProjectCheckCacheSize = 200 } + +[] +type CodeLensOptions = + { Enabled : bool + ReplaceWithLineLens: bool + UseColors: bool + Prefix : string } + static member Default = + { Enabled = false + UseColors = false + ReplaceWithLineLens = true + Prefix = "// " } + +[] +type AdvancedOptions = + { IsBlockStructureEnabled: bool + IsOutliningEnabled: bool + UsePreviewTextHover: bool } + static member Default = + { IsBlockStructureEnabled = true + IsOutliningEnabled = true + UsePreviewTextHover = false } + +[] +type FormattingOptions = + { FormatOnPaste: bool } + static member Default = + { FormatOnPaste = true } + + +[] +[)>] +type EditorOptions + [] + ( + //[)>] serviceProvider: IServiceProvider + ) = + + static let instance = EditorOptions() + + //let c = MonoDevelop.Ide.Composition.CompositionManager. + let store = SettingsStore((*serviceProvider*)) + + do + store.Register QuickInfoOptions.Default + store.Register CodeFixesOptions.Default + store.Register LanguageServicePerformanceOptions.Default + store.Register AdvancedOptions.Default + store.Register IntelliSenseOptions.Default + store.Register CodeLensOptions.Default + store.Register FormattingOptions.Default + + member __.IntelliSense : IntelliSenseOptions = store.Get() + member __.QuickInfo : QuickInfoOptions = store.Get() + member __.CodeFixes : CodeFixesOptions = store.Get() + member __.LanguageServicePerformance : LanguageServicePerformanceOptions = store.Get() + member __.Advanced: AdvancedOptions = store.Get() + member __.CodeLens: CodeLensOptions = store.Get() + member __.Formatting : FormattingOptions = store.Get() + + + static member Instance = instance + interface Microsoft.CodeAnalysis.Host.IWorkspaceService + + interface IPersistSettings with + member __.LoadSettings() = store.LoadSettings() + member __.SaveSettings(settings) = store.SaveSettings(settings) + +[] +module internal WorkspaceSettingFromDocumentExtension = + type Microsoft.CodeAnalysis.Document with + member this.FSharpOptions = EditorOptions.Instance + //this.Project.Solution.Workspace.Services.GetService() : EditorOptions diff --git a/vsintegration/src/FSharp.Editor/Options/SettingsPersistence.fs b/vsintegration/src/FSharp.Editor/Options/SettingsPersistence.fs index 096aebc9544..f5b1598a0c9 100644 --- a/vsintegration/src/FSharp.Editor/Options/SettingsPersistence.fs +++ b/vsintegration/src/FSharp.Editor/Options/SettingsPersistence.fs @@ -15,17 +15,17 @@ type IPersistSettings = [] type SVsSettingsPersistenceManager = class end -type SettingsStore(serviceProvider: IServiceProvider) = +type SettingsStore() = - let settingsManager = serviceProvider.GetService(typeof) :?> ISettingsManager + //let settingsManager = serviceProvider.GetService(typeof) :?> ISettingsManager - let storageKeyVersions (typ: Type) = - // "TextEditor" prefix seems to be required for settings changes to be synced between IDE instances - [ "TextEditor.FSharp." + typ.Namespace + "." + typ.Name - // we keep this old storage key to upgrade without reverting user changes - typ.Namespace + "." + typ.Name ] - - let storageKey (typ: Type) = storageKeyVersions typ |> List.head + //let storageKeyVersions (typ: Type) = + // // "TextEditor" prefix seems to be required for settings changes to be synced between IDE instances + // [ "TextEditor.FSharp." + typ.Namespace + "." + typ.Name + // // we keep this old storage key to upgrade without reverting user changes + // typ.Namespace + "." + typ.Name ] + + //let storageKey (typ: Type) = storageKeyVersions typ |> List.head // Each group of settings is a value of some named type, for example 'IntelliSenseOptions', 'QuickInfoOptions' // and it is usually representing one separate option page in the UI. @@ -47,16 +47,16 @@ type SettingsStore(serviceProvider: IServiceProvider) = // We make a deep copy in these instances to isolate and contain the mutation let clone (v: 't) = JsonConvert.SerializeObject v |> JsonConvert.DeserializeObject<'t> - let updateFromStore settings = - // make a deep copy so that PopulateObject does not alter the original - let copy = clone settings - // if the new key is not found by ISettingsManager, we try the old keys - // so that user settings are not lost - settings.GetType() |> storageKeyVersions - |> Seq.map (settingsManager.TryGetValue) - |> Seq.tryPick ( function GetValueResult.Success, json -> Some json | _ -> None ) - |> Option.iter (fun json -> try JsonConvert.PopulateObject(json, copy) with _ -> ()) - copy + //let updateFromStore settings = + //// make a deep copy so that PopulateObject does not alter the original + //let copy = clone settings + //// if the new key is not found by ISettingsManager, we try the old keys + //// so that user settings are not lost + //settings.GetType() |> storageKeyVersions + //|> Seq.map (settingsManager.TryGetValue) + //|> Seq.tryPick ( function GetValueResult.Success, json -> Some json | _ -> None ) + //|> Option.iter (fun json -> try JsonConvert.PopulateObject(json, copy) with _ -> ()) + //copy member __.Get() = getCached() @@ -65,20 +65,23 @@ type SettingsStore(serviceProvider: IServiceProvider) = // cloned value here because it may be altered by the UI if declared with [] member __.LoadSettings() = getCached() |> clone - member __.SaveSettings settings = - // We replace default serialization with Newtonsoft.Json for easy schema evolution. - // For example, if we add a new bool field to the record, representing another checkbox in Options dialog - // deserialization will still work fine. When we pass default value to JsonConvert.PopulateObject it will - // fill just the known fields. - settingsManager.SetValueAsync(settings.GetType() |> storageKey, JsonConvert.SerializeObject settings, false) - |> Async.AwaitTask |> Async.Start + member __.SaveSettings _settings = + //// We replace default serialization with Newtonsoft.Json for easy schema evolution. + //// For example, if we add a new bool field to the record, representing another checkbox in Options dialog + //// deserialization will still work fine. When we pass default value to JsonConvert.PopulateObject it will + //// fill just the known fields. + //settingsManager.SetValueAsync(settings.GetType() |> storageKey, JsonConvert.SerializeObject settings, false) + //|> Async.AwaitTask |> Async.Start + () // This is the point we retrieve the initial value and subscribe to watch for changes member __.Register (defaultSettings : 'options) = - defaultSettings |> updateFromStore |> keepInCache - let subset = defaultSettings.GetType() |> storageKey |> settingsManager.GetSubset - // this event is also raised when a setting change occurs in another VS instance, so we can keep everything in sync - PropertyChangedAsyncEventHandler ( fun _ _ -> - (getCached(): 'options) |> updateFromStore |> keepInCache - System.Threading.Tasks.Task.CompletedTask ) - |> subset.add_SettingChangedAsync + //defaultSettings |> updateFromStore |> keepInCache + defaultSettings |> keepInCache + //let subset = defaultSettings.GetType() |> storageKey |> settingsManager.GetSubset + //// this event is also raised when a setting change occurs in another VS instance, so we can keep everything in sync + //PropertyChangedAsyncEventHandler ( fun _ _ -> + // (getCached(): 'options) |> updateFromStore |> keepInCache + // System.Threading.Tasks.Task.CompletedTask ) + //|> subset.add_SettingChangedAsync + () diff --git a/vsintegration/src/FSharp.Editor/Properties/AddinInfo.fs b/vsintegration/src/FSharp.Editor/Properties/AddinInfo.fs new file mode 100644 index 00000000000..ffce9e1cdf8 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Properties/AddinInfo.fs @@ -0,0 +1,16 @@ +namespace Microsoft.VisualStudio.FSharp.Editor +open Mono.Addins + +[] + +[] +[] +[] + +[] +[] +[] +() \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/Navigation.fs b/vsintegration/src/FSharp.Editor/QuickInfo/Navigation.fs index 63a5041f3ea..943ba03da2f 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/Navigation.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/Navigation.fs @@ -9,7 +9,6 @@ open Microsoft.CodeAnalysis open FSharp.Compiler.SourceCodeServices open FSharp.Compiler.Range -open Microsoft.VisualStudio.Shell.Interop type internal QuickInfoNavigation ( diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs index 7b90bb3aefc..6685f85bd4f 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs @@ -12,17 +12,15 @@ open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Text open Microsoft.VisualStudio.Language.Intellisense -open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.Shell.Interop open Microsoft.VisualStudio.Text -open Microsoft.VisualStudio.Utilities open FSharp.Compiler.SourceCodeServices open FSharp.Compiler.Range open FSharp.Compiler open Internal.Utilities.StructuredFormat - +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Completion +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor type internal QuickInfo = { StructuredText: FSharpStructuredToolTipText Span: TextSpan @@ -160,7 +158,6 @@ module internal FSharpQuickInfo = type internal FSharpAsyncQuickInfoSource ( statusBar: StatusBar, - xmlMemberIndexService: IVsXMLMemberIndexService, checkerProvider:FSharpCheckerProvider, projectInfoManager:FSharpProjectOptionsManager, textBuffer:ITextBuffer, @@ -215,7 +212,7 @@ type internal FSharpAsyncQuickInfoSource | false -> Task.FromResult(null) | true -> let triggerPoint = triggerPoint.GetValueOrDefault() - let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder(xmlMemberIndexService) + let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder((*xmlMemberIndexService*)) asyncMaybe { let document = textBuffer.CurrentSnapshot.GetOpenDocumentInCurrentContextWithChanges() let! symbolUse, sigQuickInfo, targetQuickInfo = FSharpQuickInfo.getQuickInfo(checkerProvider.Checker, projectInfoManager, document, triggerPoint.Position, cancellationToken) @@ -233,9 +230,8 @@ type internal FSharpAsyncQuickInfoSource let span = getTrackingSpan quickInfo.Span return QuickInfoItem(span, content) - | Some sigQuickInfo, Some targetQuickInfo -> + | Some _sigQuickInfo, Some targetQuickInfo -> let mainDescription, targetDocumentation, sigDocumentation, typeParameterMap, exceptions, usage = ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray() - XmlDocumentation.BuildDataTipText(documentationBuilder, ignore, sigDocumentation.Add, ignore, ignore, ignore, sigQuickInfo.StructuredText) XmlDocumentation.BuildDataTipText(documentationBuilder, mainDescription.Add, targetDocumentation.Add, typeParameterMap.Add, exceptions.Add, usage.Add, targetQuickInfo.StructuredText) // get whitespace nomalized documentation text let getText (tts: seq) = @@ -266,22 +262,20 @@ type internal FSharpAsyncQuickInfoSource |> RoslynHelpers.StartAsyncAsTask cancellationToken [)>] -[] -[] -[] +[] +[] +[] type internal FSharpAsyncQuickInfoSourceProvider [] ( - [)>] serviceProvider: IServiceProvider, checkerProvider:FSharpCheckerProvider, projectInfoManager:FSharpProjectOptionsManager, settings: EditorOptions ) = interface IAsyncQuickInfoSourceProvider with - override __.TryCreateQuickInfoSource(textBuffer:ITextBuffer) : IAsyncQuickInfoSource = + override __.TryCreateQuickInfoSource(textBuffer) = // GetService calls must be made on the UI thread // It is safe to do it here (see #4713) - let statusBar = StatusBar(serviceProvider.GetService()) - let xmlMemberIndexService = serviceProvider.XMLMemberIndexService - new FSharpAsyncQuickInfoSource(statusBar, xmlMemberIndexService, checkerProvider, projectInfoManager, textBuffer, settings) :> IAsyncQuickInfoSource + let statusBar = StatusBar() + new FSharpAsyncQuickInfoSource(statusBar, checkerProvider, projectInfoManager, textBuffer, settings) :> _ diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs index 124008420fb..96866890687 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs @@ -75,7 +75,7 @@ module internal QuickInfoViewProvider = match item with | :? Layout.NavigableTaggedText as nav when navigation.IsTargetValid nav.Range -> flushRuns() - let navigableTextRun = NavigableTextRun(classificationTag, item.Text, fun () -> navigation.NavigateTo nav.Range) + let navigableTextRun = ClassifiedTextElement.CreateHyperlink(item.Text, "Navigate to " + item.Text, fun() -> navigation.NavigateTo nav.Range) currentContainerItems.Add(navigableTextRun :> obj) | _ when item.Tag = LineBreak -> flushRuns() diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/WpfNagivableTextRunViewElementFactory.fs b/vsintegration/src/FSharp.Editor/QuickInfo/WpfNagivableTextRunViewElementFactory.fs deleted file mode 100644 index f560382b34a..00000000000 --- a/vsintegration/src/FSharp.Editor/QuickInfo/WpfNagivableTextRunViewElementFactory.fs +++ /dev/null @@ -1,63 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open System -open System.ComponentModel.Composition -open System.Windows -open System.Windows.Controls - -open Microsoft.VisualStudio.Text.Adornments -open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.Utilities - -[)>] -[] -[, typeof)>] -[] -type WpfNavigableTextRunViewElementFactory - [] - ( - viewElementFactoryService:IViewElementFactoryService, - settings: EditorOptions - ) = - let styles = Microsoft.VisualStudio.FSharp.UIResources.NavStyles() - interface IViewElementFactory with - override __.CreateViewElement<'TView when 'TView: not struct>(textView:ITextView, model:obj) : 'TView = - if not (model :? NavigableTextRun) || typeof<'TView> <> typeof then - failwith <| sprintf "Invalid type conversion. Supported conversion is `%s` to `%s`." typeof.Name typeof.Name - - // use the default converters to get a UIElement - let navigableTextRun = model :?> NavigableTextRun - let classifiedTextRun = ClassifiedTextRun(navigableTextRun.ClassificationTypeName, navigableTextRun.Text) - let classifiedTextElement = ClassifiedTextElement([classifiedTextRun]) - let convertedElement = viewElementFactoryService.CreateViewElement(textView, classifiedTextElement) - - // apply HTML-like styles - match convertedElement with - | :? TextBlock as tb -> - let underlineStyle = - let key = - if settings.QuickInfo.DisplayLinks then - match settings.QuickInfo.UnderlineStyle with - | QuickInfoUnderlineStyle.Solid -> "solid_underline" - | QuickInfoUnderlineStyle.Dash -> "dash_underline" - | QuickInfoUnderlineStyle.Dot -> "dot_underline" - else - "no_underline" - styles.Resources.[key] :?> Style - - // we need to enclose the generated Inline, which is actually a Run element, - // because fancy styling does not seem to work properly with Runs - let inl = tb.Inlines.FirstInline - let color = inl.Foreground - // clear the color here to make it inherit - inl.ClearValue(Documents.TextElement.ForegroundProperty) |> ignore - // this constructor inserts into TextBlock - Documents.Underline(tb.Inlines.FirstInline, tb.ContentStart, Foreground = color) |> ignore - tb.Resources.[typeof] <- underlineStyle - | _ -> () - - // add navigation - convertedElement.MouseDown.Add(fun _ -> navigableTextRun.NavigateAction()) - convertedElement :> obj :?> 'TView diff --git a/vsintegration/src/FSharp.Editor/VSMac/CompletionService.fs b/vsintegration/src/FSharp.Editor/VSMac/CompletionService.fs new file mode 100644 index 00000000000..14c3d100062 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/CompletionService.fs @@ -0,0 +1,361 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Collections.Generic; +open System.Collections.Immutable +open System.ComponentModel.Composition +open System.Threading.Tasks + +open FSharp.Editor + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Classification +open Microsoft.CodeAnalysis.Completion +open Microsoft.CodeAnalysis.ExternalAccess.FSharp +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Completion +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor +open Microsoft.CodeAnalysis.Text; +open Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion +open Microsoft.VisualStudio.Text.Adornments; +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.Text; + +type internal FSharpInteractiveCompletionService + ( + workspace: Workspace, + checkerProvider: FSharpCheckerProvider, + projectInfoManager: FSharpProjectOptionsManager, + assemblyContentProvider: AssemblyContentProvider, + settings: EditorOptions + ) = + inherit CompletionServiceWithProviders(workspace) + + let builtInProviders = + ImmutableArray.Create( + FSharpCompletionProvider(workspace, (*serviceProvider,*) checkerProvider, projectInfoManager, assemblyContentProvider), + FSharpCommonCompletionProvider.Create( + HashDirectiveCompletionProvider(workspace, projectInfoManager, + [ Completion.Create("""\s*#load\s+(@?"*(?"[^"]*"?))""", [".fs"; ".fsx"], useIncludeDirectives = true) + Completion.Create("""\s*#r\s+(@?"*(?"[^"]*"?))""", [".dll"; ".exe"], useIncludeDirectives = true) + Completion.Create("""\s*#I\s+(@?"*(?"[^"]*"?))""", ["\x00"], useIncludeDirectives = false) ]))) + + override this.Language = FSharpConstants.FSharpLanguageName + override this.GetBuiltInProviders() = builtInProviders + override this.GetRules() = + let enterKeyRule = + match settings.IntelliSense.EnterKeySetting with + | NeverNewline -> EnterKeyRule.Never + | NewlineOnCompleteWord -> EnterKeyRule.AfterFullyTypedWord + | AlwaysNewline -> EnterKeyRule.Always + + CompletionRules.Default + .WithDismissIfEmpty(true) + .WithDismissIfLastCharacterDeleted(true) + .WithDefaultEnterKeyRule(enterKeyRule) + +type internal FSharpInteractiveCompletionSource + (textView: ITextView, checkerProvider: FSharpCheckerProvider, projectInfoManager: FSharpProjectOptionsManager, assemblyContentProvider: AssemblyContentProvider) = + + + //let settings: EditorOptions = textView.TextBuffer.GetWorkspace().Services.GetService() + + let createParagraphFromLines(lines: List) = + if lines.Count = 1 then + // The paragraph contains only one line, so it doesn't need to be added to a container. Avoiding the + // wrapping container here also avoids a wrapping element in the Cocoa elements used for rendering, + // improving efficiency. + lines.[0] :> obj + else + // The lines of a multi-line paragraph are stacked to produce the full paragraph. + ContainerElement(ContainerElementStyle.Stacked, lines |> Seq.map box) :> obj + + let toClassificationTypeName = function + | TextTags.Keyword -> + ClassificationTypeNames.Keyword + + | TextTags.Class -> + ClassificationTypeNames.ClassName + + | TextTags.Delegate -> + ClassificationTypeNames.DelegateName + + | TextTags.Enum -> + ClassificationTypeNames.EnumName + + | TextTags.Interface -> + ClassificationTypeNames.InterfaceName + + | TextTags.Module -> + ClassificationTypeNames.ModuleName + + | TextTags.Struct -> + ClassificationTypeNames.StructName + + | TextTags.TypeParameter -> + ClassificationTypeNames.TypeParameterName + + | TextTags.Field -> + ClassificationTypeNames.FieldName + + | TextTags.Event -> + ClassificationTypeNames.EventName + + | TextTags.Label -> + ClassificationTypeNames.LabelName + + | TextTags.Local -> + ClassificationTypeNames.LocalName + + | TextTags.Method -> + ClassificationTypeNames.MethodName + + | TextTags.Namespace -> + ClassificationTypeNames.NamespaceName + + | TextTags.Parameter -> + ClassificationTypeNames.ParameterName + + | TextTags.Property -> + ClassificationTypeNames.PropertyName + + | TextTags.ExtensionMethod -> + ClassificationTypeNames.ExtensionMethodName + + | TextTags.EnumMember -> + ClassificationTypeNames.EnumMemberName + + | TextTags.Constant -> + ClassificationTypeNames.ConstantName + + | TextTags.Alias + | TextTags.Assembly + | TextTags.ErrorType + | TextTags.RangeVariable -> + ClassificationTypeNames.Identifier + + | TextTags.NumericLiteral -> + ClassificationTypeNames.NumericLiteral + + | TextTags.StringLiteral -> + ClassificationTypeNames.StringLiteral + + | TextTags.Space + | TextTags.LineBreak -> + ClassificationTypeNames.WhiteSpace + + | TextTags.Operator -> + ClassificationTypeNames.Operator + + | TextTags.Punctuation -> + ClassificationTypeNames.Punctuation + + | TextTags.AnonymousTypeIndicator + | TextTags.Text + | _ -> + ClassificationTypeNames.Text + + + let buildClassifiedTextElements (taggedTexts:ImmutableArray) = + // This method produces a sequence of zero or more paragraphs + let paragraphs = new List() + + // Each paragraph is constructed from one or more lines + let currentParagraph = new List() + + // Each line is constructed from one or more inline elements + let currentRuns = new List() + + for part in taggedTexts do + if part.Tag = TextTags.LineBreak then + if currentRuns.Count > 0 then + // This line break means the end of a line within a paragraph. + currentParagraph.Add(new ClassifiedTextElement(currentRuns)); + currentRuns.Clear(); + else + // This line break means the end of a paragraph. Empty paragraphs are ignored, but could appear + // in the input to this method: + // + // * Empty elements + // * Explicit line breaks at the start of a comment + // * Multiple line breaks between paragraphs + if currentParagraph.Count > 0 then + // The current paragraph is not empty, so add it to the result collection + paragraphs.Add(createParagraphFromLines(currentParagraph)) + currentParagraph.Clear(); + + else + // This is tagged text getting added to the current line we are building. + currentRuns.Add(new ClassifiedTextRun(part.Tag |> toClassificationTypeName, part.Text)) + + if currentRuns.Count > 0 then + // Add the final line to the final paragraph. + currentParagraph.Add(new ClassifiedTextElement(currentRuns)) + + if currentParagraph.Count > 0 then + // Add the final paragraph to the result. + paragraphs.Add(createParagraphFromLines(currentParagraph)) + + paragraphs + /// + /// Called when user interacts with expander buttons, + /// requesting the completion source to provide additional completion items pertinent to the expander button. + /// For best performance, do not provide unless expansion should add new filters. + /// Called on a background thread. + /// + /// Reference to the active + /// Expander which caused this call + /// What initially caused the completion + /// Location where completion will take place, on the view's data buffer: + /// Cancellation token that may interrupt this operation + /// A struct that holds completion items and applicable span + let commitChars = [|' '; '='; ','; '.'; '<'; '>'; '('; ')'; '!'; ':'; '['; ']'; '|'|].ToImmutableArray() + + let imageCatalogGuid = Guid.Parse("ae27a6b0-e345-4288-96df-5eaf394ee369"); + let documentationBuilder = XmlDocumentation.Provider() + + interface IAsyncExpandingCompletionSource with + member __.GetExpandedCompletionContextAsync(session, expander, initialTrigger, applicableToSpan, token) = + let ctx = Data.CompletionContext.Empty + Task.FromResult ctx + + interface IAsyncCompletionSource with + member this.GetCompletionContextAsync(session, trigger, triggerLocation, applicableToSpan, token) = + async { + System.Diagnostics.Trace.WriteLine("GetCompletionContextAsync") + let (interactiveSession: InteractiveSession) = downcast textView.Properties.[typeof] + let snapshot = session.TextView.TextBuffer.CurrentSnapshot + let line = snapshot.GetLineFromPosition(triggerLocation.Position) + let start = line.Start.Position + let finish = line.End.Position + + let span = new Span(start, finish - start) + let text = snapshot.GetText(span).Trim() + session.TextView.Properties.["PotentialCommitCharacters"] <- commitChars + interactiveSession.SendCompletionRequest text (triggerLocation.Position - start + 1) + let! completions = interactiveSession.CompletionsReceived |> Async.AwaitEvent + + return + match completions with + | [||] -> + Data.CompletionContext.Empty + | _ -> + let completions = + completions + |> Array.map (fun c -> + Microsoft.VisualStudio.Language.Intellisense.AsyncCompletion.Data.CompletionItem(c.completionText, this, icon = ImageElement(GlyphHelper.getImageId c.icon))) + Data.CompletionContext(completions.ToImmutableArray()) + + } |> RoslynHelpers.StartAsyncAsTask token + + /// + /// Returns tooltip associated with provided . + /// The returned object will be rendered by . See its documentation for default supported types. + /// You may export a to provide a renderer for a custom type. + /// Since this method is called on a background thread and on multiple platforms, an instance of UIElement may not be returned. + /// + /// Reference to the active + /// which is a subject of the tooltip + /// Cancellation token that may interrupt this operation + /// An object that will be passed to . See its documentation for supported types. + member __.GetDescriptionAsync(session, item, token) = + async { + System.Diagnostics.Trace.WriteLine("GetCompletionContextAsync") + let (interactiveSession: InteractiveSession) = downcast textView.Properties.[typeof] + //let snapshot = session.TextView.TextBuffer.CurrentSnapshot + //let line = snapshot.GetLineFromPosition(triggerLocation.Position) + //let start = line.Start.Position + //let finish = line.End.Position + + //let span = new Span(start, finish - start) + //let text = snapshot.GetText(span).Trim() + //session.TextView.Properties.["PotentialCommitCharacters"] <- commitChars + interactiveSession.SendTooltipRequest item.DisplayText + let! tooltip = interactiveSession.TooltipReceived |> Async.AwaitEvent + let description = + match tooltip with + | Some description -> + let documentation = List() + let collector = RoslynHelpers.CollectTaggedText documentation + // mix main description and xmldoc by using one collector + XmlDocumentation.BuildDataTipText(documentationBuilder, collector, collector, collector, collector, collector, description) + CompletionDescription.Create(documentation.ToImmutableArray()) + | None -> + CompletionDescription.Empty + let elements = description.TaggedParts |> buildClassifiedTextElements + return ContainerElement(ContainerElementStyle.Stacked ||| ContainerElementStyle.VerticalPadding, elements |> Seq.map box) :> obj + // return + //let document = session.TextView.TextSnapshot.GetOpenDocumentInCurrentContextWithChanges() + ////let! sourceText = document.GetTextAsync() |> Async.AwaitTask + //let provider = FSharpCompletionProvider(document.Project.Solution.Workspace, checkerProvider, projectInfoManager, assemblyContentProvider) + //let! description = provider.GetDescriptionAsync2(session.TextView, item, token) |> Async.AwaitTask + //let elements = description.TaggedParts |> buildClassifiedTextElements + //return ContainerElement(ContainerElementStyle.Stacked ||| ContainerElementStyle.VerticalPadding, elements |> Seq.map box) :> obj + //return elements :> obj + } |> RoslynHelpers.StartAsyncAsTask token + + /// + /// Provides the span applicable to the prospective session. + /// Called on UI thread and expected to return very quickly, based on syntactic clues. + /// This method is called as a result of user action, after the Editor makes necessary changes in direct response to user's action. + /// The state of the Editor prior to making the text edit is captured in of . + /// This method is called sequentially on available s until one of them returns + /// with appropriate level of + /// and one returns with + /// If neither of the above conditions are met, no completion session will start. + /// + /// + /// If a language service does not wish to participate in completion, it should try to provide a valid + /// and set to false. + /// This will enable other extensions to provide completion in syntactically appropriate location. + /// + /// What causes the completion, including the character typed and reference to prior to triggering the completion + /// Location on the subject buffer that matches this 's content type + /// Cancellation token that may interrupt this operation + /// Whether this wishes to participate in completion. + member __.InitializeCompletion(trigger, triggerLocation, token) = + System.Diagnostics.Trace.WriteLine("initialize") + use _logBlock = Logger.LogBlock LogEditorFunctionId.Completion_ShouldTrigger + + let document = triggerLocation.Snapshot.GetOpenDocumentInCurrentContextWithChanges() + + let getInfo() = + let projectId = ProjectId.CreateNewId() + let documentId = DocumentId.CreateNewId(projectId) + (documentId, "temp.fsx", []) + + + let sourceText = triggerLocation.Snapshot.AsText() + let shouldTrigger = + FSharpCompletionProvider.ShouldTriggerCompletionAux(sourceText, triggerLocation.Position, trigger, getInfo, (*settings.IntelliSense*) IntelliSenseOptions.Default) + + match shouldTrigger with + | false -> + Data.CompletionStartData.DoesNotParticipateInCompletion + | true -> + Data.CompletionStartData( + participation = Data.CompletionParticipation.ProvidesItems, + applicableToSpan = new SnapshotSpan( + triggerLocation.Snapshot, + CompletionUtils.getCompletionItemSpan sourceText triggerLocation.Position)) + +[)>] +[)>] +[] +[] +type internal InteractiveCompletionSourceProvider + [] + ( + checkerProvider: FSharpCheckerProvider, + projectInfoManager: FSharpProjectOptionsManager, + assemblyContentProvider: AssemblyContentProvider + ) = + + interface IAsyncCompletionSourceProvider with + member __.GetOrCreate(textView) = + new FSharpInteractiveCompletionSource(textView, checkerProvider, projectInfoManager, assemblyContentProvider) :> _ + + interface IAsyncCompletionCommitManagerProvider with + member __.GetOrCreate(_textView) = + FSharpAsyncCompletionCommitManager() :> _ diff --git a/vsintegration/src/FSharp.Editor/VSMac/FSharpOutlineDocumentExtension.fs b/vsintegration/src/FSharp.Editor/VSMac/FSharpOutlineDocumentExtension.fs new file mode 100644 index 00000000000..44c74ef13fc --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/FSharpOutlineDocumentExtension.fs @@ -0,0 +1,187 @@ +namespace MonoDevelop.FSharp + +open System +open System.Diagnostics + +open FSharp.Compiler.SourceCodeServices +open Gtk +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Text +open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.Text +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.Threading + +open MonoDevelop.Components +open MonoDevelop.Core +open MonoDevelop.DesignerSupport +open MonoDevelop.Ide +open MonoDevelop.Ide.Gui.Components + +type internal FSharpOutlineDocumentExtension(projectInfoManager: FSharpProjectOptionsManager, checker: FSharpChecker, view: ITextView, joinableTaskContext: JoinableTaskContext) as x = + let mutable treeView : PadTreeView option = None + let mutable refreshingOutline : bool = false + let mutable timerId : uint32 = 0u + + let mutable subscriptions = ResizeArray() + + let textContainer = view.TextBuffer.AsTextContainer() + + let registration = Workspace.GetWorkspaceRegistration(textContainer) + + let getOpenDocumentInCurrentContextWithChanges(text: SourceText) = + let workspace = IdeApp.TypeSystemService.Workspace + let solution = workspace.CurrentSolution + let id = workspace.GetDocumentIdInCurrentContext(text.Container) + if id = null || not(solution.ContainsDocument(id)) then + null + else + // We update all linked files to ensure they are all in sync. Otherwise code might try to jump from + // one linked file to another and be surprised if the text is entirely different. + let allIds = workspace.GetRelatedDocumentIds(text.Container) + solution.WithDocumentText(allIds, text, PreservationMode.PreserveIdentity) + .GetDocument(id) + + let getNavigationItems(document:Document, fsSourceText) = + asyncMaybe { + let! parsingOptions, _options = projectInfoManager.TryGetOptionsByProject(document.Project, Async.DefaultCancellationToken) + + let! parseResults = checker.ParseFile(document.FilePath, fsSourceText, parsingOptions) |> liftAsync + + try + return parseResults.GetNavigationItems().Declarations + with _ -> + Debug.Assert(false, "couldn't update navigation items, ignoring") + return [| |] + } + + let refillTree() = + match treeView with + | Some(treeView) -> + + Runtime.AssertMainThread() + refreshingOutline <- false + + if treeView.IsRealized then + asyncMaybe { + let sourceText = view.TextBuffer.CurrentSnapshot.AsText() + let! document = getOpenDocumentInCurrentContextWithChanges sourceText |> Option.ofObj + let fsSourceText = sourceText.ToFSharpSourceText() + let! navItems = getNavigationItems(document, fsSourceText) + Runtime.RunInMainThread(fun() -> + let treeStore = treeView.Model :?> TreeStore + treeStore.Clear() + let toplevel = navItems + |> Array.sortBy(fun xs -> xs.Declaration.Range.StartLine) + + for item in toplevel do + let iter = treeStore.AppendValues([| item.Declaration |]) + let children = item.Nested + |> Array.sortBy(fun xs -> xs.Range.StartLine) + + for nested in children do + treeStore.AppendValues(iter, [| nested |]) |> ignore + + treeView.ExpandAll() + timerId <- 0u) |> ignore + } + |> Async.Ignore + |> Async.Start + + Gdk.Threads.Leave() + | None -> () + + refreshingOutline <- false + false + + let updateDocumentOutline _ = + if not refreshingOutline then + refreshingOutline <- true + timerId <- GLib.Timeout.Add (1000u, (fun _ -> refillTree())) + + do + subscriptions.Add (registration.WorkspaceChanged.Subscribe(updateDocumentOutline)) + subscriptions.Add (view.TextBuffer.PostChanged.Subscribe(updateDocumentOutline)) + updateDocumentOutline None + + interface IDisposable with + override x.Dispose() = + if timerId > 0u then + GLib.Source.Remove timerId |> ignore + for disposable in subscriptions do disposable.Dispose() + subscriptions.Clear() + timerId <- 0u + + interface IOutlinedDocument with + member x.GetOutlineWidget() = + match treeView with + | Some(treeView) -> treeView :> Widget + | None -> + let treeStore = new TreeStore(typedefof) + let padTreeView = new PadTreeView(treeStore, HeadersVisible = true) + + let setCellIcon _column (cellRenderer : CellRenderer) (treeModel : TreeModel) (iter : TreeIter) = + let pixRenderer = cellRenderer :?> CellRendererImage + treeModel.GetValue(iter, 0) + |> Option.tryCast + |> Option.iter(fun item -> + pixRenderer.Image <- ImageService.GetIcon(VSMacIcons.getIcon item.[0], Gtk.IconSize.Menu)) + + let setCellText _column (cellRenderer : CellRenderer) (treeModel : TreeModel) (iter : TreeIter) = + let renderer = cellRenderer :?> CellRendererText + treeModel.GetValue(iter, 0) + |> Option.tryCast + |> Option.iter(fun item -> renderer.Text <- item.[0].Name) + + let jumpToDeclaration focus = + let iter : TreeIter ref = ref Unchecked.defaultof<_> + if padTreeView.Selection.GetSelected(iter) then + padTreeView.Model.GetValue(!iter, 0) + |> Option.tryCast + |> Option.iter(fun item -> + let sourceText = view.TextBuffer.CurrentSnapshot.AsText() + let node = item.[0] + let pos = RoslynHelpers.FSharpRangeToTextSpan(sourceText, node.Range).Start + let point = new SnapshotPoint(view.TextSnapshot, pos) + view.Caret.MoveTo(point) |> ignore + view.ViewScroller.EnsureSpanVisible(new SnapshotSpan(view.Caret.Position.BufferPosition, 0), EnsureSpanVisibleOptions.AlwaysCenter)) + + if focus then + view + |> Option.tryCast + |> Option.iter(fun view -> view.Focus()) + + treeView <- Some padTreeView + + let pixRenderer = new CellRendererImage(Xpad = 0u, Ypad = 0u) + padTreeView.TextRenderer.Xpad <- 0u + padTreeView.TextRenderer.Ypad <- 0u + + let treeCol = new TreeViewColumn() + treeCol.PackStart(pixRenderer, false) + treeCol.SetCellDataFunc(pixRenderer, new TreeCellDataFunc(setCellIcon)) + treeCol.PackStart(padTreeView.TextRenderer, true) + treeCol.SetCellDataFunc(padTreeView.TextRenderer, new TreeCellDataFunc(setCellText)) + + padTreeView.AppendColumn treeCol |> ignore + subscriptions.Add(padTreeView.Realized.Subscribe(fun _ -> refillTree |> ignore)) + subscriptions.Add(padTreeView.Selection.Changed.Subscribe(fun _ -> jumpToDeclaration false)) + subscriptions.Add(padTreeView.RowActivated.Subscribe(fun _ -> jumpToDeclaration true)) + + let sw = new CompactScrolledWindow() + sw.Add padTreeView + sw.ShowAll() + sw :> Widget + + member x.GetToolbarWidgets() = [] :> _ + + member x.ReleaseOutlineWidget() = + treeView |> Option.iter(fun tv -> + Option.tryCast(tv.Parent) + |> Option.iter (fun sw -> sw.Destroy()) + + match tv.Model with + :? TreeStore as ts -> ts.Dispose() + | _ -> ()) + + treeView <- None diff --git a/vsintegration/src/FSharp.Editor/VSMac/FSharpOutlineDocumentExtensionProvider.fs b/vsintegration/src/FSharp.Editor/VSMac/FSharpOutlineDocumentExtensionProvider.fs new file mode 100644 index 00000000000..b99ffa320f4 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/FSharpOutlineDocumentExtensionProvider.fs @@ -0,0 +1,49 @@ +namespace MonoDevelop.FSharp +// +// FSharpPathedDocumentExtensionProvider.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft. All rights reserved. +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. + + +open System.ComponentModel.Composition +open Microsoft.VisualStudio.Text.Editor +open MonoDevelop.TextEditor +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor +open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.Threading + +[)>] +[] +[] +[] +type internal FSharpOutlineDocumentExtensionProvider + [] + ( + fsharpCheckerProvider: FSharpCheckerProvider, + optionsManager: FSharpProjectOptionsManager, + joinableTaskContext: JoinableTaskContext + ) as x = + inherit EditorContentInstanceProvider() + + override x.CreateInstance(view) = new FSharpOutlineDocumentExtension(optionsManager, fsharpCheckerProvider.Checker, view, joinableTaskContext) diff --git a/vsintegration/src/FSharp.Editor/VSMac/FSharpPathedDocumentExtension.fs b/vsintegration/src/FSharp.Editor/VSMac/FSharpPathedDocumentExtension.fs new file mode 100644 index 00000000000..9d183f21672 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/FSharpPathedDocumentExtension.fs @@ -0,0 +1,277 @@ +namespace MonoDevelop.FSharp +open System +open System.Diagnostics +open System.Linq +open System.Threading + +open FSharp.Compiler.SourceCodeServices + +open Microsoft.CodeAnalysis.Text +open Microsoft.CodeAnalysis +open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.Text +open Microsoft.VisualStudio.Threading + +open MonoDevelop.Components +open MonoDevelop.Core +open MonoDevelop.Ide +open MonoDevelop.Ide.Gui.Content +open MonoDevelop.Projects + +module VSMacIcons = + /// Translates icon code that we get from F# language service into a MonoDevelop icon + let getIcon (navItem: FSharpNavigationDeclarationItem) = + match navItem.Kind with + | NamespaceDecl -> "md-name-space" + | _ -> + match navItem.Glyph with + | FSharpGlyph.Class -> "md-class" + | FSharpGlyph.Enum -> "md-enum" + | FSharpGlyph.Struct -> "md-struct" + | FSharpGlyph.ExtensionMethod -> "md-struct" + | FSharpGlyph.Delegate -> "md-delegate" + | FSharpGlyph.Interface -> "md-interface" + | FSharpGlyph.Module -> "md-module" + | FSharpGlyph.NameSpace -> "md-name-space" + | FSharpGlyph.Method -> "md-method" + | FSharpGlyph.OverridenMethod -> "md-method" + | FSharpGlyph.Property -> "md-property" + | FSharpGlyph.Event -> "md-event" + | FSharpGlyph.Constant -> "md-field" + | FSharpGlyph.EnumMember -> "md-field" + | FSharpGlyph.Exception -> "md-exception" + | FSharpGlyph.Typedef -> "md-class" + | FSharpGlyph.Type -> "md-type" + | FSharpGlyph.Union -> "md-type" + | FSharpGlyph.Variable -> "md-field" + | FSharpGlyph.Field -> "md-field" + | FSharpGlyph.Error -> "md-breakpint" + +type internal FSharpPathedDocumentExtension(projectInfoManager: FSharpProjectOptionsManager, checker: FSharpChecker, view: ITextView, joinableTaskContext: JoinableTaskContext) as x = + + let pathChanged = new Event<_,_>() + let mutable currentPath = [||] + let mutable subscriptions = ResizeArray() + let mutable ownerProjects = ResizeArray() + let mutable lastOwnerProjects = ResizeArray() + let mutable registration: WorkspaceRegistration = null + + let textContainer = view.TextBuffer.AsTextContainer() + + let getRelatedDocuments(container: SourceTextContainer) = + let workspace = IdeApp.TypeSystemService.Workspace + let sol = workspace.CurrentSolution + let ids = workspace.GetRelatedDocumentIds(container) + + ids + |> Seq.map(fun id -> sol.GetDocument(id)) + |> Seq.filter (isNull >> not) + + let getActiveDocument() = + let workspace = IdeApp.TypeSystemService.Workspace + let id = workspace.GetDocumentIdInCurrentContext(textContainer) + workspace.CurrentSolution.GetDocument(id) |> Option.ofObj + + let workspaceChanged(_) = + ownerProjects.Clear() + match getActiveDocument() with + | Some activeDocument -> + let activeProj = IdeServices.TypeSystemService.GetMonoProject(activeDocument.Project) :?> DotNetProject + if activeProj <> null then + ownerProjects.Add activeProj + else + for document in textContainer |> getRelatedDocuments do + let dotnetProj = IdeServices.TypeSystemService.GetMonoProject(document.Project) :?> DotNetProject + if dotnetProj <> null && document.Project.Id <> activeDocument.Project.Id then + ownerProjects.Add dotnetProj + + | None -> () + + let getOpenDocumentInCurrentContextWithChanges(text: SourceText) = + let workspace = IdeApp.TypeSystemService.Workspace + let solution = workspace.CurrentSolution + let id = workspace.GetDocumentIdInCurrentContext(text.Container) + if id = null || not(solution.ContainsDocument(id)) then + null + else + // We update all linked files to ensure they are all in sync. Otherwise code might try to jump from + // one linked file to another and be surprised if the text is entirely different. + let allIds = workspace.GetRelatedDocumentIds(text.Container) + solution.WithDocumentText(allIds, text, PreservationMode.PreserveIdentity) + .GetDocument(id) + + let mutable lastSnapshot: ITextSnapshot = null + let mutable lastOffset = 0 + + let update(position: CaretPosition) = + let snapshot = position.BufferPosition.Snapshot + let offset = position.BufferPosition.Position + + if lastSnapshot = snapshot && lastOffset = offset && ownerProjects.SequenceEqual(lastOwnerProjects) then + () + else + lastSnapshot <- snapshot + lastOffset <- offset + lastOwnerProjects <- ownerProjects.ToList() + + let roslynDocument = snapshot.AsText() |> getOpenDocumentInCurrentContextWithChanges + if roslynDocument <> null then + x.Update(roslynDocument, position.BufferPosition.Position) + + + let caretPositionChanged (caretPositionChangedArgs: CaretPositionChangedEventArgs) = + update caretPositionChangedArgs.NewPosition + + let textBufferChanged(_args) = + update view.Caret.Position + + do + registration <- Microsoft.CodeAnalysis.Workspace.GetWorkspaceRegistration(textContainer) + subscriptions.Add (registration.WorkspaceChanged.Subscribe(workspaceChanged)) + subscriptions.Add (view.TextBuffer.PostChanged.Subscribe(textBufferChanged)) + subscriptions.Add (view.Caret.PositionChanged.Subscribe(caretPositionChanged)) + currentPath <- [| new PathEntry(GettextCatalog.GetString("No selection")) |] + workspaceChanged None + + member x.GetEntityMarkup(node: FSharpNavigationDeclarationItem) = + let name = node.Name.Split('.') + if name.Length > 0 then name.Last() + else node.Name + + member x.GetNavigationItems(document:Document, fsSourceText) = + asyncMaybe { + let! parsingOptions, _options = projectInfoManager.TryGetOptionsByProject(document.Project, Async.DefaultCancellationToken) + + let! parseResults = checker.ParseFile(document.FilePath, fsSourceText, parsingOptions) |> liftAsync + + try + return parseResults.GetNavigationItems().Declarations + with _ -> + Debug.Assert(false, "couldn't update navigation items, ignoring") + return [| |] + } + + member val SourceText : SourceText = null with get, set + + member private x.Update(document:Document, caretOffset) = + let caretLocation = TextSpan(caretOffset, 1) + + asyncMaybe { + let! sourceText = document.GetTextAsync(Async.DefaultCancellationToken) |> liftTaskAsync + x.SourceText <- sourceText + let fsSourceText = sourceText.ToFSharpSourceText() + let! toplevel = x.GetNavigationItems(document, fsSourceText) + + let topLevelTypesInsideCursor = + toplevel + |> Array.filter (fun tl -> let range = tl.Declaration.Range + let declLocation = RoslynHelpers.FSharpRangeToTextSpan(sourceText, range) + caretLocation.IntersectsWith(declLocation)) + |> Array.sortBy(fun xs -> xs.Declaration.Range.StartLine) + + let newPath = ResizeArray<_>() + + let paths = + [ for top in topLevelTypesInsideCursor do + let name = top.Declaration.Name + let navitems = + if name.Contains(".") then + let nameparts = name.[.. name.LastIndexOf(".")] + toplevel |> Array.filter (fun decl -> decl.Declaration.Name.StartsWith(nameparts)) + else toplevel + yield (Some top.Declaration, (upcast navitems : obj)) + + if topLevelTypesInsideCursor.Length > 0 then + let lastToplevel = topLevelTypesInsideCursor.Last() + //only first child found is returned, could there be multiple children found? + let child = + lastToplevel.Nested + |> Array.tryFind (fun tl -> let range = RoslynHelpers.FSharpRangeToTextSpan(sourceText, tl.Range) + caretLocation.IntersectsWith(range)) + match child with + | Some c -> yield (Some c, upcast lastToplevel) + | None -> yield (None, upcast lastToplevel) ] + let previousPath = currentPath + + Runtime.RunInMainThread(fun() -> + paths |> List.iter(fun (declItemOption, tag) -> + match declItemOption with + | Some declItem -> + newPath.Add(new PathEntry(icon = ImageService.GetIcon(VSMacIcons.getIcon declItem, Gtk.IconSize.Menu), + markup =x.GetEntityMarkup(declItem), + Tag = tag)) + | None -> + newPath.Add(new PathEntry("No selection", Tag = tag))) + + let samePath = Seq.forall2 (fun (p1:PathEntry) (p2:PathEntry) -> p1.Markup = p2.Markup) previousPath newPath + + //ensure the path has changed from the previous one before setting and raising event. + if not samePath then + if newPath.Count = 0 then currentPath <- [|new PathEntry("No selection", Tag = null)|] + else currentPath <- newPath.ToArray() + + //invoke pathChanged + pathChanged.Trigger(x, DocumentPathChangedEventArgs(previousPath))) |> ignore + } + |> Async.Ignore + |> Async.Start + + interface IDisposable with + override x.Dispose() = + for disposable in subscriptions do disposable.Dispose() + subscriptions.Clear() + + interface IPathedDocument with + member x.CurrentPath = currentPath + + member x.CreatePathWidget(index) = + let path = (x :> IPathedDocument).CurrentPath + if path = null || index < 0 || index >= path.Length then null else + let tag = path.[index].Tag + let window = new DropDownBoxListWindow(FSharpDataProvider(x, tag, view), FixedRowHeight=22, MaxVisibleRows=14) + window.SelectItem (path.[index].Tag) + MonoDevelop.Components.Control.op_Implicit window + + member x.add_PathChanged(handler) = pathChanged.Publish.AddHandler(handler) + member x.remove_PathChanged(handler) = pathChanged.Publish.RemoveHandler(handler) + +and internal FSharpDataProvider(ext:FSharpPathedDocumentExtension, tag, view: ITextView) = + let memberList = ResizeArray<_>() + + let reset() = + memberList.Clear() + match tag with + | :? array as navitems -> + for decl in navitems do + memberList.Add(decl.Declaration) + | :? FSharpNavigationTopLevelDeclaration as tld -> + memberList.AddRange(tld.Nested) + | _ -> () + + do reset() + + interface DropDownBoxListWindow.IListDataProvider with + member x.IconCount = + memberList.Count + + member x.Reset() = reset() + + member x.GetTag (n) = + memberList.[n] :> obj + + member x.ActivateItem(n) = + let node = memberList.[n] + let pos = RoslynHelpers.FSharpRangeToTextSpan(ext.SourceText, node.Range).Start + let point = new SnapshotPoint(view.TextSnapshot, pos) + view.Caret.MoveTo(point) |> ignore + view.ViewScroller.EnsureSpanVisible(new SnapshotSpan(view.Caret.Position.BufferPosition, 0), EnsureSpanVisibleOptions.AlwaysCenter); + + member x.GetMarkup(n) = + let node = memberList.[n] + ext.GetEntityMarkup (node) + + member x.GetIcon(n) = + let node = memberList.[n] + ImageService.GetIcon(VSMacIcons.getIcon node, Gtk.IconSize.Menu) + diff --git a/vsintegration/src/FSharp.Editor/VSMac/FSharpPathedDocumentExtensionProvider.fs b/vsintegration/src/FSharp.Editor/VSMac/FSharpPathedDocumentExtensionProvider.fs new file mode 100644 index 00000000000..37ea6ef8d07 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/FSharpPathedDocumentExtensionProvider.fs @@ -0,0 +1,49 @@ +namespace MonoDevelop.FSharp +// +// FSharpPathedDocumentExtensionProvider.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft. All rights reserved. +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. + + +open System.ComponentModel.Composition +open Microsoft.VisualStudio.Text.Editor +open MonoDevelop.TextEditor +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor +open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.Threading + +[)>] +[] +[] +[] +type internal FSharpPathedDocumentExtensionProvider + [] + ( + fsharpCheckerProvider: FSharpCheckerProvider, + optionsManager: FSharpProjectOptionsManager, + joinableTaskContext: JoinableTaskContext + ) as x = + inherit EditorContentInstanceProvider() + + override x.CreateInstance(view) = new FSharpPathedDocumentExtension(optionsManager, fsharpCheckerProvider.Checker, view, joinableTaskContext) diff --git a/vsintegration/src/FSharp.Editor/VSMac/FSharpProjectFileNodeExtension.fs b/vsintegration/src/FSharp.Editor/VSMac/FSharpProjectFileNodeExtension.fs new file mode 100644 index 00000000000..aca41fc1923 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/FSharpProjectFileNodeExtension.fs @@ -0,0 +1,219 @@ +namespace MonoDevelop.FSharp + +open System.Linq +open System.Xml +open System.Xml.Linq + +module Linq2Xml = + let xn = XName.op_Implicit + let xs ns local = XName.Get(local, ns) + let firstOrDefault seq = Enumerable.FirstOrDefault(seq) + let firstOrNone seq = + let iter = Enumerable.FirstOrDefault(seq) + match iter with null -> None | _ -> Some(iter) + + let singleOrDefault seq = Enumerable.SingleOrDefault(seq) + let where (pred: XElement -> bool) elements = Enumerable.Where(elements, pred) + let attribute name (element:XElement) = element.Attribute <| xn name + let attributeValue name element = (attribute name element).Value + let descendants xs (element: XElement) = element.Descendants(xs) + let previousNodeOrNone (element: XElement) = + match element.PreviousNode with + | null -> None + | node -> Some(node) + +open System +open System.IO +open MonoDevelop.Core +open MonoDevelop.Ide.Gui.Components +open MonoDevelop.Projects +open MonoDevelop.Ide +open MonoDevelop.Ide.Gui.Pads.ProjectPad +open Linq2Xml + +/// The command handler type for nodes in F# projects in the solution explorer. +type FSharpProjectNodeCommandHandler() = + inherit NodeCommandHandler() + + /// Reload project causing the node tree up refresh with new ordering + let reloadProject (file: ProjectFile) = + use monitor = IdeApp.Workbench.ProgressMonitors.GetProjectLoadProgressMonitor(true) + monitor.BeginTask("Reloading Project", 1) |> ignore + file.Project.ParentFolder.ReloadItem(monitor, file.Project) |> ignore + monitor.Step (1) + monitor.EndTask() + + let fileIsInFSharpProject (file: ProjectFile) = + file.Project.SupportedLanguages |> Array.contains "F#" + + let rec moveNodeInXDoc (xdoc:XElement) (moveToNode: ProjectFile) (movingNode:ProjectFile) position isNested = + let descendantsNamed ns name ancestor = + ///partially apply the default namespace of msbuild to xs + let xd = xs ns + descendants (xd name) ancestor + + // If the "Compile" element contains a "Link" element then it is a linked file, + // so use that value for comparison when finding the node. + let nodeName ns (node:XElement) = + let link = node |> descendantsNamed ns "Link" |> firstOrNone + match link with + | Some l -> l.Value + | None -> node |> attributeValue "Include" + + let defaultNamespace = xdoc.GetDefaultNamespace().NamespaceName + let descendantsByNamespace = descendantsNamed defaultNamespace + //get movable nodes from the project file + let movableNodes = (descendantsByNamespace "Compile" xdoc). + Concat(descendantsByNamespace "EmbeddedResource" xdoc). + Concat(descendantsByNamespace "Content" xdoc). + Concat(descendantsByNamespace "None" xdoc) + + let findByIncludeFile name seq = + seq |> where (fun elem -> nodeName defaultNamespace elem = name ) + |> firstOrNone + + let getFullName (pf:ProjectFile) = pf.ProjectVirtualPath.ToString().Replace("/", "\\") + + let movingElement = movableNodes |> findByIncludeFile (getFullName movingNode) + let moveToElement = movableNodes |> findByIncludeFile (getFullName moveToNode) + + let addFunction (moveTo:XElement) (position:DropPosition) = + match position with + | DropPosition.Before -> moveTo.AddBeforeSelf : obj -> unit + | DropPosition.After -> moveTo.AddAfterSelf : obj -> unit + | _ -> ignore + + match (movingElement, moveToElement, position) with + | Some(moving), Some(moveTo), (DropPosition.Before | DropPosition.After) -> + moving.Remove() + // If the moving node contains a DependentUpon node as a child remove the DependentUpon nodes, + // only if the moving node was moved directly - not via moving the parent node + if not isNested then + moving |> descendantsByNamespace "DependentUpon" |> Seq.iter (fun node -> node.Remove()) + //get the add function using the position + let add = addFunction moveTo position + add(moving) + + // If any of the project files depend on the file + // being moved, then move those files below the file being moved + movingNode.Project.Files + |> Seq.filter(fun f -> f.DependsOnFile = movingNode) + |> Seq.iter(fun f -> moveNodeInXDoc xdoc movingNode f DropPosition.After true) + + | _ -> ()//If we cant find both nodes or the position isnt before or after we dont continue + + member x.MoveNodes (moveToNode: ProjectFile) (movingNode:ProjectFile) position = + let projectFile = movingNode.Project.FileName.ToString() + + let xdoc = XElement.Load(projectFile) + + moveNodeInXDoc xdoc moveToNode movingNode position false + + let settings = XmlWriterSettings(OmitXmlDeclaration = true, Indent = true) + use writer = XmlWriter.Create(projectFile, settings) + xdoc.Save(writer); + writer.Close() + + /// Implement drag and drop of nodes in F# projects in the solution explorer. + override x.OnNodeDrop(dataObject, dragOperation, position) = + match dataObject, dragOperation with + | :? ProjectFile as movingNode, DragOperation.Move -> + //Move as long as this is a drag op and the moving node is a project file + match x.CurrentNode.DataItem with + | :? ProjectFile as moveToNode -> + x.MoveNodes moveToNode movingNode position + reloadProject moveToNode + | _ -> ()//unsupported + | _ -> //otherwise use the base behaviour + base.OnNodeDrop(dataObject, dragOperation, position) + + /// Implement drag and drop of nodes in F# projects in the solution explorer. + override x.CanDragNode() = DragOperation.Move + + /// Implement drag and drop of nodes in F# projects in the solution explorer. + override x.CanDropNode(dataObject, _dragOperation) = + //currently we are going to only support dropping project files from the same parent project + match (dataObject, x.CurrentNode.DataItem) with + | (:? ProjectFile as drag), (:? ProjectFile as drop) when fileIsInFSharpProject drag && fileIsInFSharpProject drop -> + drag <> drop && + drag.Project = drop.Project && drop.ProjectVirtualPath.ParentDirectory = drag.ProjectVirtualPath.ParentDirectory + | _ -> false + + /// Implement drag and drop of nodes in F# projects in the solution explorer. + override x.CanDropNode(dataObject, dragOperation, _position) = + x.CanDropNode(dataObject, dragOperation) + //This would allow anything to be droppped as long as it was in the same project and path level + //We would need to add to moveNodes so it knows how to find ProvectFolders and other items that mught be present + // | drag, drop -> + // match getProjectAndPath drag, getProjectAndPath drop with + // | Some(project1, project1Path), Some(project2, project2Path) -> project1 = project2 && project1Path.ParentDirectory = project2Path.ParentDirectory + // | _ -> false + + +/// MD/XS extension for the F# project nodes in the solution explorer. +type FSharpProjectFileNodeExtension() = + inherit NodeBuilderExtension() + + let (|FSharpProject|_|) (project:Project) = + match project with + | :? DotNetProject as dnp when dnp.LanguageName = "F#" -> Some dnp + | _ -> None + + /// Check if an item in the project model is recognized by this extension. + let (|SupportedProjectFile|SupportedProjectFolder|NotSupported|) (item:obj) = + match item with + | :? ProjectFile as projfile when projfile.Project <> null -> + match projfile.Project with + | FSharpProject _ -> SupportedProjectFile(projfile) + | _ -> NotSupported + | :? ProjectFolder as projfolder when projfolder.Project <> null -> + match projfolder.Project with + | FSharpProject _ -> SupportedProjectFolder(projfolder) + | _ -> NotSupported + | _ -> NotSupported + + let findIndex thing = + match thing with + | SupportedProjectFile(file) -> file.Project.Files.IndexOf(file) + | SupportedProjectFolder(folder) -> + let childfile = + folder.Project.Files + |> Seq.tryFind (fun p -> + let filePath = + match p.IsLink with + | true -> + p.Link.ToAbsolute(folder.Project.FileName.ParentDirectory) + | false -> + p.FilePath + filePath.IsChildPathOf folder.Path) + + match childfile with + | Some file -> folder.Project.Files.IndexOf file + | None -> //fallback to finding a directory subtype + let folderIndex = + folder.Project.Files + |> Seq.filter (fun file -> file.Subtype = Subtype.Directory) + |> Seq.tryFindIndex(fun pf -> pf.FilePath = folder.Path) + match folderIndex with + | Some i -> i + | _ -> NodeBuilder.DefaultSort + | NotSupported -> NodeBuilder.DefaultSort + + + override x.CanBuildNode(dataType:Type) = + // Extend any file or folder belonging to a F# project + typedefof.IsAssignableFrom(dataType) || typedefof.IsAssignableFrom (dataType) + + member x.Compare (thisDataItem: 'a) (otherDataItem: 'a) = + match (thisDataItem, otherDataItem) with + | SupportedProjectFile thisNode, SupportedProjectFile other -> compare (findIndex thisNode) (findIndex other) + | SupportedProjectFolder thisNode, SupportedProjectFolder other -> compare (findIndex thisNode) (findIndex other) + | SupportedProjectFile thisNode, SupportedProjectFolder other -> compare (findIndex thisNode) (findIndex other) + | SupportedProjectFolder thisNode, SupportedProjectFile other -> compare (findIndex thisNode) (findIndex other) + | _ -> NodeBuilder.DefaultSort + + override x.CompareObjects(thisNode:ITreeNavigator, otherNode:ITreeNavigator) : int = + x.Compare thisNode.DataItem otherNode.DataItem + + override x.CommandHandlerType = typeof + diff --git a/vsintegration/src/FSharp.Editor/VSMac/FSharpSymbolHelper.fs b/vsintegration/src/FSharp.Editor/VSMac/FSharpSymbolHelper.fs new file mode 100644 index 00000000000..25f38f5f7fa --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/FSharpSymbolHelper.fs @@ -0,0 +1,203 @@ +namespace MonoDevelop.FSharp.Shared +open System +open System.Collections.Generic +open System.Text +open FSharp.Compiler +open FSharp.Compiler.SourceCodeServices + +module Symbols = + let getLocationFromSymbolUse (s: FSharpSymbolUse) = + [s.Symbol.DeclarationLocation; s.Symbol.SignatureLocation] + |> List.choose id + |> List.distinctBy (fun r -> r.FileName) + + let getLocationFromSymbol (s:FSharpSymbol) = + [s.DeclarationLocation; s.SignatureLocation] + |> List.choose id + |> List.distinctBy (fun r -> r.FileName) + +[] +module SymbolUse = + let (|ActivePatternCase|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpActivePatternCase as ap-> ActivePatternCase(ap) |> Some + | _ -> None + + let (|Entity|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpEntity as ent -> Some ent + | _ -> None + + let (|Field|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpField as field-> Some field + | _ -> None + + let (|GenericParameter|_|) (symbol: FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpGenericParameter as gp -> Some gp + | _ -> None + + let (|MemberFunctionOrValue|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpMemberOrFunctionOrValue as func -> Some func + | _ -> None + + let (|ActivePattern|_|) = function + | MemberFunctionOrValue m when m.IsActivePattern -> Some m | _ -> None + + let (|Parameter|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpParameter as param -> Some param + | _ -> None + + let (|StaticParameter|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpStaticParameter as sp -> Some sp + | _ -> None + + let (|UnionCase|_|) (symbol : FSharpSymbolUse) = + match symbol.Symbol with + | :? FSharpUnionCase as uc-> Some uc + | _ -> None + + let (|Constructor|_|) = function + | MemberFunctionOrValue func when func.IsConstructor || func.IsImplicitConstructor -> Some func + | _ -> None + + let (|TypeAbbreviation|_|) = function + | Entity symbol when symbol.IsFSharpAbbreviation -> Some symbol + | _ -> None + + let (|Class|_|) = function + | Entity symbol when symbol.IsClass -> Some symbol + | Entity s when s.IsFSharp && + s.IsOpaque && + not s.IsFSharpModule && + not s.IsNamespace && + not s.IsDelegate && + not s.IsFSharpUnion && + not s.IsFSharpRecord && + not s.IsInterface && + not s.IsValueType -> Some s + | _ -> None + + let (|Delegate|_|) = function + | Entity symbol when symbol.IsDelegate -> Some symbol + | _ -> None + + let (|Event|_|) = function + | MemberFunctionOrValue symbol when symbol.IsEvent -> Some symbol + | _ -> None + + let (|Property|_|) = function + | MemberFunctionOrValue symbol when symbol.IsProperty || symbol.IsPropertyGetterMethod || symbol.IsPropertySetterMethod -> Some symbol + | _ -> None + + let inline private notCtorOrProp (symbol:FSharpMemberOrFunctionOrValue) = + not symbol.IsConstructor && not symbol.IsPropertyGetterMethod && not symbol.IsPropertySetterMethod + + let (|Method|_|) (symbolUse:FSharpSymbolUse) = + match symbolUse with + | MemberFunctionOrValue symbol when symbol.IsModuleValueOrMember && + not symbolUse.IsFromPattern && + not symbol.IsOperatorOrActivePattern && + not symbol.IsPropertyGetterMethod && + not symbol.IsPropertySetterMethod -> Some symbol + | _ -> None + + let (|Function|_|) (symbolUse:FSharpSymbolUse) = + match symbolUse with + | MemberFunctionOrValue symbol when notCtorOrProp symbol && + symbol.IsModuleValueOrMember && + not symbol.IsOperatorOrActivePattern && + not symbolUse.IsFromPattern -> + match symbol.FullTypeSafe with + | Some fullType when fullType.IsFunctionType -> Some symbol + | _ -> None + | _ -> None + + let (|Operator|_|) (symbolUse:FSharpSymbolUse) = + match symbolUse with + | MemberFunctionOrValue symbol when notCtorOrProp symbol && + not symbolUse.IsFromPattern && + not symbol.IsActivePattern && + symbol.IsOperatorOrActivePattern -> + match symbol.FullTypeSafe with + | Some fullType when fullType.IsFunctionType -> Some symbol + | _ -> None + | _ -> None + + let (|Pattern|_|) (symbolUse:FSharpSymbolUse) = + match symbolUse with + | MemberFunctionOrValue symbol when notCtorOrProp symbol && + not symbol.IsOperatorOrActivePattern && + symbolUse.IsFromPattern -> + match symbol.FullTypeSafe with + | Some fullType when fullType.IsFunctionType ->Some symbol + | _ -> None + | _ -> None + + + let (|ClosureOrNestedFunction|_|) = function + | MemberFunctionOrValue symbol when notCtorOrProp symbol && + not symbol.IsOperatorOrActivePattern && + not symbol.IsModuleValueOrMember -> + match symbol.FullTypeSafe with + | Some fullType when fullType.IsFunctionType -> Some symbol + | _ -> None + | _ -> None + + + let (|Val|_|) = function + | MemberFunctionOrValue symbol when notCtorOrProp symbol && + not symbol.IsOperatorOrActivePattern -> + match symbol.FullTypeSafe with + | Some _fullType -> Some symbol + | _ -> None + | _ -> None + + let (|Enum|_|) = function + | Entity symbol when symbol.IsEnum -> Some symbol + | _ -> None + + let (|Interface|_|) = function + | Entity symbol when symbol.IsInterface -> Some symbol + | _ -> None + + let (|Module|_|) = function + | Entity symbol when symbol.IsFSharpModule -> Some symbol + | _ -> None + + let (|Namespace|_|) = function + | Entity symbol when symbol.IsNamespace -> Some symbol + | _ -> None + + let (|Record|_|) = function + | Entity symbol when symbol.IsFSharpRecord -> Some symbol + | _ -> None + + let (|Union|_|) = function + | Entity symbol when symbol.IsFSharpUnion -> Some symbol + | _ -> None + + let (|ValueType|_|) = function + | Entity symbol when symbol.IsValueType && not symbol.IsEnum -> Some symbol + | _ -> None + + let (|ComputationExpression|_|) (symbol:FSharpSymbolUse) = + if symbol.IsFromComputationExpression then Some symbol + else None + + let (|Attribute|_|) = function + | Entity ent -> + if ent.AllBaseTypes + |> Seq.exists (fun t -> + if t.HasTypeDefinition then + t.TypeDefinition.TryFullName + |> Option.exists ((=) "System.Attribute" ) + else false) + then Some ent + else None + | _ -> None + diff --git a/vsintegration/src/FSharp.Editor/VSMac/GlobalSearch.fs b/vsintegration/src/FSharp.Editor/VSMac/GlobalSearch.fs new file mode 100644 index 00000000000..6803369b9b7 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/GlobalSearch.fs @@ -0,0 +1,241 @@ +namespace MonoDevelop.FSharp +open System.Collections.Generic +open System.Threading.Tasks +open MonoDevelop.Core +open MonoDevelop.Core.Text +open MonoDevelop.Components.MainToolbar +open MonoDevelop.Ide +open MonoDevelop.Ide.Gui +open MonoDevelop.Projects +open FSharp.Compiler.SourceCodeServices +open MonoDevelop.FSharp.Shared +open MonoDevelop.Ide.Composition +open Microsoft.VisualStudio.FSharp.Editor +open MonoDevelop.Ide.TypeSystem + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.ExternalAccess.FSharp +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.FindUsages +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor.FindUsages +open FSharp.Compiler.Range +open FSharp.Compiler.SourceCodeServices +[] +module Accessibility = + let inline getImage name = ImageService.GetIcon( name, Gtk.IconSize.Menu) + + let inline getImageFromAccessibility pub inter priv typeWithAccessibility = + let accessibility = (^a : (member Accessibility : FSharpAccessibility) typeWithAccessibility) + if accessibility.IsPublic then getImage pub + elif accessibility.IsInternal then getImage inter + else getImage priv + +module DisplayName = + let correct(symbol:FSharpSymbolUse) = + match symbol with + | SymbolUse.Constructor c -> + match c.DeclaringEntity with + | Some ent -> ent.DisplayName + | _ -> LoggingService.LogError(sprintf "Constructor with no EnclosingEntity: %s" c.DisplayName) + c.DisplayName + | _ -> symbol.Symbol.DisplayName + + +type SymbolSearchResult(match', matchedString, rank, symbol:FSharpSymbolUse, span:FSharpDocumentSpan) = + inherit SearchResult(match', matchedString, rank) + + let simpleName = DisplayName.correct symbol + //let offsetAndLength = lazy Symbols.getOffsetAndLength simpleName symbol + + override x.SearchResultType = + match symbol with + | SymbolUse.Record _ | SymbolUse.Module _ | SymbolUse.ValueType _ | SymbolUse.Delegate _ | SymbolUse.Union _ | SymbolUse.Class _ + | SymbolUse.Namespace _ | SymbolUse.Interface _ | SymbolUse.Enum _ | SymbolUse.ActivePattern _ -> SearchResultType.Type + + | SymbolUse.ActivePatternCase _ | SymbolUse.Field _ | SymbolUse.UnionCase _ | SymbolUse.Property _ + | SymbolUse.Event _ | SymbolUse.Operator _ | SymbolUse.Constructor _ | SymbolUse.Function _ | SymbolUse.Val _-> SearchResultType.Member + | _ -> SearchResultType.Unknown + + override x.Description = + let cat = + match symbol with + | SymbolUse.Record _ -> "record" + | SymbolUse.Module _ -> "module" + | SymbolUse.ValueType _ -> "struct" + | SymbolUse.Delegate _ -> "delegate" + | SymbolUse.Union _ -> "union" + | SymbolUse.Class c -> if c.IsFSharp then "type" else "class" + | SymbolUse.Namespace _ -> "namespace" + | SymbolUse.Interface _ -> "interface" + | SymbolUse.Enum _ -> "enum" + | SymbolUse.ActivePattern _ -> "active pattern" + | SymbolUse.Field _ -> "field" + | SymbolUse.UnionCase _ -> "union case" + | SymbolUse.Property _ -> "property" + | SymbolUse.Event _ -> "event" + | SymbolUse.Operator _ -> "operator" + | SymbolUse.Constructor _ -> "constructor" + | SymbolUse.Method _ -> "method" + | SymbolUse.Function _ -> "function" + | SymbolUse.Val _ -> "val" + | _ -> "symbol" + sprintf "%s (file %s)" cat symbol.RangeAlternate.FileName + + override x.PlainText = simpleName + + override x.File = symbol.RangeAlternate.FileName + override x.Icon = + match symbol with + | SymbolUse.Record _ -> getImage "md-type" + | SymbolUse.Module _ -> getImage "md-module" + | SymbolUse.ValueType s -> s |> getImageFromAccessibility Stock.Struct.Name Stock.InternalStruct.Name Stock.PrivateStruct.Name + | SymbolUse.Delegate d -> d |> getImageFromAccessibility Stock.Delegate.Name Stock.InternalDelegate.Name Stock.PrivateDelegate.Name + | SymbolUse.Union _ -> getImage "md-type" + | SymbolUse.Class c -> if c.IsFSharp then getImage "md-type" else c |> getImageFromAccessibility Stock.Class.Name Stock.InternalClass.Name Stock.PrivateClass.Name + | SymbolUse.Namespace _ -> getImage Stock.NameSpace.Name + | SymbolUse.Interface i -> i |> getImageFromAccessibility Stock.Interface.Name Stock.InternalInterface.Name Stock.PrivateInterface.Name + | SymbolUse.Enum e -> e |> getImageFromAccessibility Stock.Enum.Name Stock.InternalEnum.Name Stock.PrivateEnum.Name + | SymbolUse.ActivePattern _ -> getImage "md-type" + | SymbolUse.Field f ->f |> getImageFromAccessibility Stock.Field.Name Stock.InternalField.Name Stock.PrivateField.Name + | SymbolUse.UnionCase _ -> getImage "md-type" + | SymbolUse.Property p -> p |> getImageFromAccessibility Stock.Property.Name Stock.InternalProperty.Name Stock.PrivateProperty.Name + | SymbolUse.Event e -> e |> getImageFromAccessibility Stock.Event.Name Stock.InternalEvent.Name Stock.PrivateEvent.Name + | SymbolUse.Operator _ -> getImage "md-fs-field" + | SymbolUse.Constructor c -> c |> getImageFromAccessibility Stock.Method.Name Stock.InternalMethod.Name Stock.PrivateMethod.Name + | SymbolUse.Function mfv -> + if mfv.IsExtensionMember then mfv |> getImageFromAccessibility "md-extensionmethod" "md-internal-extensionmethod" "md-private-extensionmethod" + elif mfv.IsMember then mfv |> getImageFromAccessibility Stock.Method.Name Stock.InternalMethod.Name Stock.PrivateMethod.Name + else getImage "md-fs-field" + | SymbolUse.Val _ -> getImage "md-fs-field" //NOTE: Maybe make this a normal field icon? + | _ -> getImage Stock.Event.Name + + //override x.GetTooltipInformation(token) = + // SymbolTooltips.getTooltipInformation symbol |> StartAsyncAsTask token + + override x.Offset = span.SourceSpan.Start// fst (offsetAndLength.Force()) + override x.Length = span.SourceSpan.Length// snd (offsetAndLength.Force()) + +module GlobalSearch = + let inline private is expr s = + match expr s with Some _ -> true | None -> false + + let private filter tag (s:FSharpSymbolUse seq) = + match tag with + | "type" | "t" | "c" -> s |> Seq.filter (is (|Class|_|)) + | "mod" -> s |> Seq.filter (is (|Module|_|)) + | "s" -> s |> Seq.filter (is (|ValueType|_|)) + | "i" -> s |> Seq.filter (is (|Interface|_|)) + | "e" -> s |> Seq.filter (is (|Enum|_|)) + | "d" -> s |> Seq.filter (is (|Delegate|_|)) + | "u" -> s |> Seq.filter (is (|Union|_|)) + | "r" -> s |> Seq.filter (is (|Record|_|)) + | "member" | "m" -> s |> Seq.filter (is (|Method|_|)) + | "p" -> s |> Seq.filter (is (|Property|_|)) + | "f" -> s |> Seq.filter (is (|Field|_|)) + | "ap" -> s |> Seq.filter (is (|ActivePattern|_|)) + | "op" -> s |> Seq.filter (is (|Operator|_|)) + | _ -> s + + let byTag tag (items: FSharpSymbolUse seq) = + let filtered = items |> filter tag + filtered + + let getAllFSharpProjects() = + seq { for p in IdeApp.Workspace.GetAllProjects() do + if p.SupportedLanguages |> Array.contains "F#" then + yield p } + + let byPattern (cache:Dictionary<_,_>) pattern symbols = + + let matchName (matcher:StringMatcher) (name:string) = + if name = null then (false, -1) + else + match cache.TryGetValue(name) with + | true, v -> v + | false, _ -> + let doesMatch, rank = matcher.CalcMatchRank (name) + let savedMatch = (doesMatch, rank) + cache.Add(name, savedMatch) + savedMatch + + let matcher = StringMatcher.GetMatcher (pattern, false) + + symbols + |> Seq.choose (fun s -> let doesMatch, rank = matchName matcher (DisplayName.correct s) + if doesMatch then Some(s, rank) + else None) + + // File can be included in more than one project, hence single `range` may results with multiple `Document`s. + let rangeToDocumentSpans (solution: Solution, range: range) = + async { + if range.Start = range.End then return [] + else + let! spans = + solution.GetDocumentIdsWithFilePath(range.FileName) + |> Seq.map (fun documentId -> + async { + let doc = solution.GetDocument(documentId) + let! cancellationToken = Async.CancellationToken + let! sourceText = doc.GetTextAsync(cancellationToken) |> Async.AwaitTask + match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with + | Some span -> + let span = Tokenizer.fixupSpan(sourceText, span) + return Some (FSharpDocumentSpan(doc, span)) + | None -> return None + }) + |> Async.Parallel + return spans |> Array.choose id |> Array.toList + } + + let internal getSymbolUsesInWorkspace (projectInfoManager: FSharpProjectOptionsManager) (pattern: SearchPopupSearchPattern) (callback: ISearchResultCallback) token = + let (workspace: MonoDevelopWorkspace) = downcast IdeApp.TypeSystemService.Workspace + + let cachingSearch = byPattern (Dictionary<_,_>()) + workspace.CurrentSolution.Projects + |> Seq.filter(fun project -> project.Language = "F#") + |> Seq.map (fun project -> + async { + match! projectInfoManager.TryGetOptionsByProject(project, token) with + | Some (_parsingOptions, projectOptions) -> + let! projectCheckResults = projectInfoManager.Checker.ParseAndCheckProject(projectOptions, userOpName = "F# Global Search") + let! allProjectSymbols = projectCheckResults.GetAllUsesOfAllSymbols() + //LoggingService.LogInfo(sprintf "F# Global Search: Filtering %i project symbols from %s, for definitions" (allProjectSymbols |> Seq.length) shortName ) + let definitions = allProjectSymbols |> Seq.filter (fun s -> s.IsFromDefinition) + + //LoggingService.LogInfo(sprintf "F# Global Search: Filtering %i matching tag %s for %s" (definitions |> Seq.length) pattern.Tag shortName ) + let tagFiltered = definitions |> byTag pattern.Tag + + //LoggingService.LogInfo(sprintf "F# Global Search: Caching search on %i typeFilteredSymbols for matching pattern %s on %s" (tagFiltered |> Seq.length) pattern.Pattern shortName ) + let matchedSymbols = tagFiltered |> cachingSearch pattern.Pattern + + //LoggingService.LogInfo(sprintf "F# Global Search: Matched %i symbols from %s" (matchedSymbols |> Seq.length) shortName ) + for symbol:FSharpSymbolUse, rank in matchedSymbols do + let! spans = rangeToDocumentSpans (workspace.CurrentSolution, symbol.RangeAlternate) + for span in spans do + let sr = SymbolSearchResult(pattern.Pattern, symbol.Symbol.DisplayName, rank, symbol, span) + callback.ReportResult sr + | None -> () + }) + |> Async.Parallel + |> Async.Ignore + + /// constructors have a display name of ( .ctor ) use the enclosing entities display name +type ProjectSearchCategory() = + inherit SearchCategory(GettextCatalog.GetString ("Solution"), sortOrder = SearchCategory.FirstCategoryOrder) + + //type, module, struct, interface, enum, delegate, union, record + let typeTags = ["type"; "t"; "c"; "mod"; "s"; "i"; "e"; "d"; "u"; "r" ] + + //member, property, field, event, active pattern, operator + let memberTags = ["member"; "m"; "p"; "f"; "evt"; "ap"; "op"] + let tags = lazy (List.concat [typeTags; memberTags] |> List.toArray) + + override x.get_Tags() = tags.Force() + + override x.IsValidTag tag = + typeTags |> List.contains tag || memberTags |> List.contains tag + + override x.GetResults(callback, pattern, token) = + let optionsManager = CompositionManager.Instance.GetExportedValue() + GlobalSearch.getSymbolUsesInWorkspace optionsManager pattern callback token + |> RoslynHelpers.StartAsyncUnitAsTask token + diff --git a/vsintegration/src/FSharp.Editor/VSMac/InteractiveClassificationService.fs b/vsintegration/src/FSharp.Editor/VSMac/InteractiveClassificationService.fs new file mode 100644 index 00000000000..9970397a32d --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/InteractiveClassificationService.fs @@ -0,0 +1,68 @@ +// +// InteractiveClassificationService.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. +namespace Microsoft.VisualStudio.FSharp.Editor + +open System.ComponentModel.Composition +open System.Collections.Generic +open System.Threading + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Classification +open Microsoft.CodeAnalysis.Text +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification + +[)>] +type internal FSharpInteractiveClassificationService + [] + ( + service: IFSharpClassificationService + ) = + interface IFSharpInteractiveClassificationService with + + member __.AddLexicalClassifications(sourceText: SourceText, textSpan: TextSpan, result: List, cancellationToken: CancellationToken) = + () + + member __.AddSyntacticClassificationsAsync(document: Document, textSpan: TextSpan, result: List, cancellationToken: CancellationToken) = + let classificationTask = + maybe { + match document.TryGetText() with + | true, sourceText -> + let line = sourceText.Lines.GetLineFromPosition(textSpan.Start).LineNumber + let! fsi = FSharpInteractivePad.Fsi + let! controller = fsi.Controller + if controller.IsInputLine(line) then + return! service.AddSyntacticClassificationsAsync(document, textSpan, result, cancellationToken) |> Some + else + return! None + | false, _ -> return! None + } + match classificationTask with + | Some classifications -> classifications + | None -> Tasks.Task.CompletedTask + + // Do not perform classification if we don't have project options (#defines matter) + member __.AdjustStaleClassification(_: SourceText, classifiedSpan: ClassifiedSpan) : ClassifiedSpan = classifiedSpan + diff --git a/vsintegration/src/FSharp.Editor/VSMac/InteractiveGlyph.fs b/vsintegration/src/FSharp.Editor/VSMac/InteractiveGlyph.fs new file mode 100644 index 00000000000..7a968f90e1a --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/InteractiveGlyph.fs @@ -0,0 +1,106 @@ +// +// InteractiveGlyph.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. +namespace Microsoft.VisualStudio.FSharp.Editor + +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.Core.Imaging +open System.ComponentModel.Composition +open Microsoft.VisualStudio.Text.Tagging +open System +open System.Collections.Generic +open Microsoft.VisualStudio.Text +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor + +type InteractivePromptGlyphTag() = interface IGlyphTag + +type InteractiveGlyphFactory(imageId:ImageId, imageService:IImageService) = + let mutable imageCache: AppKit.NSImage option = None + + interface IGlyphFactory with + member x.GenerateGlyph(line, tag) = + match tag with + | :? InteractivePromptGlyphTag -> + if imageCache.IsNone then + imageCache <- Some(imageService.GetImage (imageId) :?> AppKit.NSImage) + let imageView = AppKit.NSImageView.FromImage imageCache.Value + imageView.SetFrameSize (imageView.FittingSize) + Some (box imageView) + | _ -> None + |> Option.toObj + +[)>] +[] +[] +[)>] +type InteractiveGlyphFactoryProvider() as this = + [] + member val ImageService:IImageService = null with get, set + + interface IGlyphFactoryProvider with + member x.GetGlyphFactory(view, margin) = + let imageId = ImageId(Guid("{3404e281-57a6-4f3a-972b-185a683e0753}"), 1) + upcast InteractiveGlyphFactory(imageId, x.ImageService) + +type InteractivePromptGlyphTagger(textView: ITextView) as this = + let tagsChanged = Event<_,_>() + + let promptSpans = HashSet<_>() + + let getLastLine() = + let snapshot = textView.TextBuffer.CurrentSnapshot + let lineCount = snapshot.LineCount + + if lineCount > 0 then + Some (snapshot.GetLineFromLineNumber(lineCount - 1)) + else + None + + let isOnLastLine(pos:int) = + match getLastLine() with + | Some line -> line.Start.Position = pos + | None -> false + + do + textView.Properties.[typeof] <- this + + member x.AddPrompt(pos:int) = + if promptSpans.Add(pos) then + tagsChanged.Trigger(this, SnapshotSpanEventArgs(SnapshotSpan(textView.TextSnapshot, pos, 1))) + + interface ITagger with + [] + member this.TagsChanged = tagsChanged.Publish + + member x.GetTags(spans) = + seq { + for span in spans do + if promptSpans.Contains(span.Start.Position) || isOnLastLine(span.Start.Position) then + yield TagSpan(span, InteractivePromptGlyphTag()) + } + +module InteractiveGlyphManagerService = + let interactiveGlyphTagger(textView: ITextView) = + textView.Properties.GetOrCreateSingletonProperty(typeof, fun () -> InteractivePromptGlyphTagger textView) diff --git a/vsintegration/src/FSharp.Editor/VSMac/InteractivePad.fs b/vsintegration/src/FSharp.Editor/VSMac/InteractivePad.fs new file mode 100644 index 00000000000..052bd956adf --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/InteractivePad.fs @@ -0,0 +1,455 @@ + +// +// InteractivePad.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Collections.Generic +open System.ComponentModel.Composition +open System.IO +open FSharp.Editor + +open Gtk + +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor +open Microsoft.VisualStudio.FSharp.Editor +open Microsoft.VisualStudio.Text +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.Text.Tagging +open MonoDevelop.Components +open MonoDevelop.Components.Commands +open MonoDevelop.Components.Docking +open MonoDevelop.Core +open MonoDevelop.Core.Execution +open MonoDevelop.FSharp +open MonoDevelop.Ide +open MonoDevelop.Ide.Composition + +type FSharpCommands = + | ShowFSharpInteractive = 0 + | SendSelection = 1 + | SendLine = 2 + | SendFile = 3 + +type KillIntent = + | Restart + | Kill + | NoIntent // Unexpected kill, or from #q/#quit, so we prompt + +type ShellHistory() = + let history = ResizeArray() + let mutable nextUp = 0 + let mutable nextDown = 0 + + member x.Push command = + history.Add command + nextUp <- history.Count - 1 + nextDown <- history.Count - 1 + + member x.Up() = + match nextUp with + | -1 -> None + | index when index >= history.Count -> None + | index -> + nextDown <- nextUp + nextUp <- nextUp - 1 + Some history.[index] + + member x.Down() = + if nextDown = history.Count then + None + else + nextUp <- nextDown + nextDown <- nextDown + 1 + if nextDown = history.Count then + None + else + Some history.[nextDown] + + +[] +[] +[] +type InteractivePadController(session: InteractiveSession) as this = + let mutable view = null + let contentTypeRegistry = CompositionManager.Instance.GetExportedValue() + let textBufferFactory = CompositionManager.Instance.GetExportedValue() + let factory = CompositionManager.Instance.GetExportedValue() + let contentType = contentTypeRegistry.GetContentType(FSharpContentTypeNames.FSharpInteractiveContentType) + + let roles = factory.CreateTextViewRoleSet(PredefinedTextViewRoles.Editable, PredefinedTextViewRoles.Interactive, PredefinedTextViewRoles.Document) + let textBuffer = textBufferFactory.CreateTextBuffer("", contentType) + + let textView = factory.CreateTextView(textBuffer, roles) + + let workspace = new InteractiveWorkspace() + let history = ShellHistory() + do + //resourceDictionary.[ClassificationFormatDefinition.TypefaceId] <- TextField.Font + //resourceDictionary.[ClassificationFormatDefinition.FontRenderingSizeId] <- 20 + //resourceDictionary.[ClassificationFormatDefinition.BackgroundBrushId] <- System.Windows.Media.Brushes.Black + //resourceDictionary.[ClassificationFormatDefinition.ForegroundColorId] <- System.Windows.Media.Brushes.White + //editorFormat.SetProperties("Plain Text", resourceDictionary) + + textView.Options.SetOptionValue(DefaultTextViewOptions.UseVisibleWhitespaceId, false) + textView.Options.SetOptionValue(DefaultTextViewHostOptions.ChangeTrackingId, false) + textView.Options.SetOptionValue(DefaultTextViewHostOptions.LineNumberMarginId, false) + textView.Options.SetOptionValue(DefaultTextViewHostOptions.OutliningMarginId, false) + textView.Options.SetOptionValue(DefaultTextViewHostOptions.GlyphMarginId, true) + textView.VisualElement.TranslatesAutoresizingMaskIntoConstraints <- false + textView.Properties.[typeof] <- this + textView.Properties.[typeof] <- session + let host = factory.CreateTextViewHost(textView, true) + view <- host.HostControl + workspace.CreateDocument(textBuffer) + + let getActiveDocumentFileName () = + if IdeApp.Workbench.ActiveDocument <> null && FileService.isInsideFSharpFile() then + let docFileName = IdeApp.Workbench.ActiveDocument.FileName.ToString() + if docFileName <> null then + let directoryName = Path.GetDirectoryName docFileName + Some docFileName + else None + else None + + let inputLines = HashSet() + + let getLastLine() = + let snapshot = textBuffer.CurrentSnapshot + let lineCount = snapshot.LineCount + + if lineCount > 0 then + Some (snapshot.GetLineFromLineNumber(lineCount - 1)) + else + None + + let setCaretLine text = + getLastLine() |> Option.iter(fun line -> + use edit = textBuffer.CreateEdit() + + if edit.Replace(new Span(line.Start.Position, line.Length), text) then + edit.Apply() |> ignore) + + let scrollToLastLine() = + getLastLine() |> Option.iter(fun line -> + let snapshotSpan = new SnapshotSpan(line.Start, 0) + textView.ViewScroller.EnsureSpanVisible(snapshotSpan)) + + let mutable readOnlyRegion = None + + let updateReadOnlyRegion() = + getLastLine() |> Option.iter(fun line -> + use edit = textBuffer.CreateReadOnlyRegionEdit() + + readOnlyRegion |> Option.iter(fun region -> edit.RemoveReadOnlyRegion region) + readOnlyRegion <- edit.CreateReadOnlyRegion(new Span(0, line.Start.Position - 1)) |> Some + + edit.Apply() |> ignore) + + member this.View = view + member this.Session = session + + member this.IsInputLine(line:int) = + let buffer = textView.TextBuffer + inputLines.Contains line + + member this.FsiInput text = + let fileName = getActiveDocumentFileName() + history.Push text + let buffer = textView.TextBuffer + session.SendInput (text + "\n") fileName + + member this.FsiOutput text = + let buffer = textView.TextBuffer + use edit = buffer.CreateEdit() + let position = buffer.CurrentSnapshot.Length + + if edit.Insert(position, text) then + edit.Apply() |> ignore + scrollToLastLine() + updateReadOnlyRegion() + + member this.Clear() = + inputLines.Clear() + use readOnlyEdit = textBuffer.CreateReadOnlyRegionEdit() + readOnlyRegion |> Option.iter(fun region -> readOnlyEdit.RemoveReadOnlyRegion region) + readOnlyRegion <- None + readOnlyEdit.Apply() |> ignore + + use edit = textView.TextBuffer.CreateEdit() + edit.Delete(0, textView.TextBuffer.CurrentSnapshot.Length) |> ignore + edit.Apply() |> ignore + + member this.SetPrompt() = + this.FsiOutput "\n" + let buffer = textView.TextBuffer + let snapshot = buffer.CurrentSnapshot + let lastLine = snapshot.GetLineFromLineNumber(snapshot.LineCount - 1) + let glyphTagger = InteractiveGlyphManagerService.interactiveGlyphTagger(textView) + inputLines.Add(snapshot.LineCount - 1) |> ignore + + glyphTagger.AddPrompt lastLine.Start.Position + scrollToLastLine() + updateReadOnlyRegion() + + member this.HistoryUp() = + history.Up() |> Option.iter setCaretLine + + member this.HistoryDown() = + history.Down() + |> function Some c -> setCaretLine c | None -> setCaretLine "" + + member this.EnsureLastLine() = + getLastLine() |> Option.iter(fun line -> + if textView.Caret.Position.BufferPosition.Position < line.Start.Position then + textView.Caret.MoveTo(line.End) |> ignore) + +[)>] +[] +[)>] +type InteractivePromptGlyphTaggerProvider() = + interface IViewTaggerProvider with + member x.CreateTagger(textView, buffer) = + box(InteractivePromptGlyphTagger textView) :?> _ + +type FSharpInteractivePad() as this = + inherit MonoDevelop.Ide.Gui.PadContent() + + let mutable killIntent = NoIntent + let mutable activeDoc : IDisposable option = None + let mutable lastLineOutput = None + + let promptIcon = ImageService.GetIcon("md-breadcrumb-next") + let newLineIcon = ImageService.GetIcon("md-template") + + let getActiveDocumentFileName () = + if IdeApp.Workbench.ActiveDocument <> null && FileService.isInsideFSharpFile() then + let docFileName = IdeApp.Workbench.ActiveDocument.FileName.ToString() + if docFileName <> null then + let directoryName = Path.GetDirectoryName docFileName + Some docFileName + else None + else None + + let input = new ResizeArray<_>() + + let setupSession() = + let pathToExe = + Path.Combine(Reflection.Assembly.GetExecutingAssembly().Location |> Path.GetDirectoryName, "MonoDevelop.FSharpInteractive.Service.exe") + |> ProcessArgumentBuilder.Quote + let ses = InteractiveSession(pathToExe) + let controller = new InteractivePadController(ses) + this.Controller <- Some controller + this.Host <- new GtkNSViewHost(controller.View) + this.Host.ShowAll() + input.Clear() + ses.TextReceived.Add(fun t -> + Runtime.RunInMainThread(fun () -> controller.FsiOutput t) |> ignore) + ses.PromptReady.Add(fun () -> Runtime.RunInMainThread(fun () -> controller.SetPrompt() ) |> ignore) + ses + + let mutable session = None + + let resetFsi intent = + input.Clear() + killIntent <- intent + this.Controller |> Option.iter (fun controller -> controller.Clear()) + session |> Option.iter (fun (ses:InteractiveSession) -> ses.Restart()) + + member x.Session = session + + member x.Shutdown() = + do LoggingService.LogDebug ("Interactive: Shutdown()!") + resetFsi Kill + + member x.SendCommand command = + let fileName = getActiveDocumentFileName() + + input.Add command + session + |> Option.iter(fun ses -> + ses.SendInput (command + ";;") fileName) + + override x.Dispose() = + LoggingService.LogDebug ("Interactive: disposing pad...") + activeDoc |> Option.iter (fun ad -> ad.Dispose()) + x.Shutdown() + + override x.Control = Control.op_Implicit x.Host + + static member Pad = + try let pad = IdeApp.Workbench.GetPad() + + if pad <> null then Some(pad) + else + //*attempt* to add the pad manually this seems to fail sporadically on updates and reinstalls, returning null + let pad = IdeApp.Workbench.AddPad(new FSharpInteractivePad(), + "FSharp.MonoDevelop.FSharpInteractivePad", + "F# Interactive", + "Center Bottom", + IconId("md-fs-project")) + if pad <> null then Some(pad) + else None + with exn -> None + + static member BringToFront(grabfocus) = + FSharpInteractivePad.Pad |> Option.iter (fun pad -> pad.BringToFront(grabfocus)) + + static member Fsi = + FSharpInteractivePad.Pad |> Option.bind (fun pad -> Some(pad.Content :?> FSharpInteractivePad)) + + member x.LastOutputLine + with get() = lastLineOutput + and set value = lastLineOutput <- value + + member x.SendSelection() = + if x.IsSelectionNonEmpty then + let textView = IdeApp.Workbench.ActiveDocument.GetContent() + for span in textView.Selection.VirtualSelectedSpans do + x.SendCommand (span.GetText()) + else + //if nothing is selected send the whole line + x.SendLine() + + member x.SendLine() = + if isNull IdeApp.Workbench.ActiveDocument then () + else + let view = IdeApp.Workbench.ActiveDocument.GetContent(); + let line = view.Caret.Position.BufferPosition.GetContainingLine(); + let text = line.GetText() + x.SendCommand text + + member x.SendFile() = + let text = IdeApp.Workbench.ActiveDocument.TextBuffer.CurrentSnapshot.GetText() + x.SendCommand text + + member x.IsSelectionNonEmpty = + if isNull IdeApp.Workbench.ActiveDocument || + isNull IdeApp.Workbench.ActiveDocument.FileName.FileName then false + else + let textView = IdeApp.Workbench.ActiveDocument.GetContent() + not(textView.Selection.IsEmpty) + + member x.LoadReferences(project:FSharpProject) = + LoggingService.LogDebug ("FSI: #LoadReferences") + async { + let! orderedReferences = project.GetOrderedReferences (CompilerArguments.getConfig()) + orderedReferences |> List.iter (fun a -> x.SendCommand (sprintf @"#r ""%s""" a.Path)) + } |> Async.StartImmediate + + member val Host:GtkNSViewHost = null with get, set + member val Controller:InteractivePadController option = None with get, set + + override x.Initialize(container:MonoDevelop.Ide.Gui.IPadWindow) = + LoggingService.LogDebug ("InteractivePad: created!") + let toolbar = container.GetToolbar(DockPositionType.Right) + + let addButton(icon, action, tooltip) = + let button = new DockToolButton(icon) + button.Clicked.Add(action) + button.TooltipText <- tooltip + toolbar.Add(button) + + addButton ("gtk-save", (fun _ -> x.Save()), GettextCatalog.GetString ("Save as script")) + addButton ("gtk-open", (fun _ -> x.OpenScript()), GettextCatalog.GetString ("Open")) + addButton ("gtk-clear", (fun _ -> x.ClearFsi()), GettextCatalog.GetString ("Clear")) + addButton ("gtk-refresh", (fun _ -> x.RestartFsi()), GettextCatalog.GetString ("Reset")) + toolbar.ShowAll() + let ses = setupSession() + session <- ses |> Some + + container.PadContentShown.Add(fun _args -> if not ses.HasStarted then ses.StartReceiving() |> ignore) + + member x.RestartFsi() = resetFsi Restart + + member x.ClearFsi() = x.Controller |> Option.iter(fun c -> c.Clear()) + + member x.Save() = + let dlg = new MonoDevelop.Ide.Gui.Dialogs.OpenFileDialog(GettextCatalog.GetString ("Save as .fsx"), MonoDevelop.Components.FileChooserAction.Save) + + dlg.DefaultFilter <- dlg.AddFilter (GettextCatalog.GetString ("F# script files"), "*.fsx") + if dlg.Run () then + let file = + if dlg.SelectedFile.Extension = ".fsx" then + dlg.SelectedFile + else + dlg.SelectedFile.ChangeExtension(".fsx") + + let lines = input |> Seq.map (fun line -> line.TrimEnd(';')) + let fileContent = String.concat "\n" lines + File.WriteAllText(file.FullPath.ToString(), fileContent) + + member x.OpenScript() = + let dlg = MonoDevelop.Ide.Gui.Dialogs.OpenFileDialog(GettextCatalog.GetString ("Open script"), MonoDevelop.Components.FileChooserAction.Open) + dlg.AddFilter (GettextCatalog.GetString ("F# script files"), [|".fs"; "*.fsi"; "*.fsx"; "*.fsscript"; "*.ml"; "*.mli" |]) |> ignore + if dlg.Run () then + let file = dlg.SelectedFile + x.SendCommand ("#load @\"" + file.FullPath.ToString() + "\"") + +type InteractiveCommand(command) = + inherit CommandHandler() + + override x.Run() = + FSharpInteractivePad.Fsi + |> Option.iter (fun fsi -> command fsi + FSharpInteractivePad.BringToFront(false)) + +type FSharpFileInteractiveCommand(command) = + inherit InteractiveCommand(command) + + override x.Update(info:CommandInfo) = + info.Enabled <- true + info.Visible <- FileService.isInsideFSharpFile() + +type ShowFSharpInteractive() = + inherit InteractiveCommand(ignore) + override x.Update(info:CommandInfo) = + info.Enabled <- true + info.Visible <- true + +type SendSelection() = + inherit FSharpFileInteractiveCommand(fun fsi -> fsi.SendSelection()) + +type SendLine() = + inherit FSharpFileInteractiveCommand(fun fsi -> fsi.SendLine()) + +type SendFile() = + inherit FSharpFileInteractiveCommand(fun fsi -> fsi.SendFile()) + +type SendReferences() = + inherit CommandHandler() + override x.Run() = + async { + let project = IdeApp.Workbench.ActiveDocument.Owner :?> FSharpProject + FSharpInteractivePad.Fsi + |> Option.iter (fun fsi -> fsi.LoadReferences(project) + FSharpInteractivePad.BringToFront(false)) + } |> Async.StartImmediate + +type RestartFsi() = + inherit InteractiveCommand(fun fsi -> fsi.RestartFsi()) + +type ClearFsi() = + inherit InteractiveCommand(fun fsi -> fsi.ClearFsi()) diff --git a/vsintegration/src/FSharp.Editor/VSMac/InteractivePadKeyHandlers.fs b/vsintegration/src/FSharp.Editor/VSMac/InteractivePadKeyHandlers.fs new file mode 100644 index 00000000000..c704445d11f --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/InteractivePadKeyHandlers.fs @@ -0,0 +1,155 @@ +// +// InteractivePadKeyHandlers.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. +namespace Microsoft.VisualStudio.FSharp.Editor + +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor +open System.ComponentModel.Composition +open Microsoft.VisualStudio.Language.Intellisense +open Microsoft.VisualStudio.Text.Editor.Commanding.Commands +open Microsoft.VisualStudio.Commanding +open Microsoft.VisualStudio.Text + +[] +[] +[)>] +type InteractivePadCompletionReturnHandler + [] + ( completionBroker:ICompletionBroker, + signatureHelpBroker:ISignatureHelpBroker ) = + interface ICommandHandler with + member x.DisplayName = "InteractivePadKeyReturnHandler" + member x.GetCommandState _args = CommandState.Available + + member x.ExecuteCommand(args, context) = + let textView = args.TextView + signatureHelpBroker.DismissAllSessions(textView) + if completionBroker.IsCompletionActive(textView) then + false + else + let (controller: InteractivePadController) = downcast textView.Properties.[typeof] + + let textBuffer = textView.TextBuffer + let snapshot = textBuffer.CurrentSnapshot + let position = textView.Caret.Position.BufferPosition.Position + let line = snapshot.GetLineFromPosition(position) + + if line.Length > 0 then + let start = line.Start.Position + let finish = line.End.Position + let start = min start finish + let span = Span(start, finish - start) + let text = snapshot.GetText(span) + controller.FsiOutput "\n" + controller.FsiInput text + true + +[] +[] +[)>] +type InteractivePadCompletionTypeCharHandler + [] + ( completionBroker:ICompletionBroker, + signatureHelpBroker:ISignatureHelpBroker ) = + interface ICommandHandler with + member x.DisplayName = "InteractivePadTypeCharHandler" + member x.GetCommandState _args = CommandState.Available + + member x.ExecuteCommand(args, _context) = + if args.TypedChar <> '(' && args.TypedChar <> ',' && args.TypedChar <> ' ' then + signatureHelpBroker.DismissAllSessions(args.TextView) + let textView = args.TextView + let (controller: InteractivePadController) = downcast textView.Properties.[typeof] + controller.EnsureLastLine() + false + +[] +[] +[)>] +type InteractivePadCompletionBackspaceHandler + [] + ( completionBroker:ICompletionBroker ) = + + interface ICommandHandler with + member x.DisplayName = "InteractivePadKeyBackspaceHandler" + member x.GetCommandState _args = CommandState.Available + + member x.ExecuteCommand(args, _context) = + let textView = args.TextView + let snapshot = textView.TextBuffer.CurrentSnapshot + let lineCount = snapshot.LineCount + + if lineCount > 0 then + let line = snapshot.GetLineFromLineNumber(lineCount - 1) + if textView.Caret.Position.BufferPosition.Position > line.Start.Position then + false + else + true + else + true + +[] +[] +[)>] +type InteractivePadCompletionUpHandler + [] + ( completionBroker:ICompletionBroker, + signatureHelpBroker:ISignatureHelpBroker ) = + interface ICommandHandler with + member x.DisplayName = "InteractivePadKeyUpHandler" + member x.GetCommandState _args = CommandState.Available + + member x.ExecuteCommand(args, context) = + if signatureHelpBroker.IsSignatureHelpActive(args.TextView) then + false + else if completionBroker.IsCompletionActive(args.TextView) then + false + else + let textView = args.TextView + let (controller: InteractivePadController) = downcast textView.Properties.[typeof] + controller.HistoryUp() + true + +[] +[] +[)>] +type InteractivePadCompletionDownHandler + [] + ( completionBroker:ICompletionBroker, + signatureHelpBroker:ISignatureHelpBroker ) = + interface ICommandHandler with + member x.DisplayName = "InteractivePadKeyDownHandler" + member x.GetCommandState _args = CommandState.Available + + member x.ExecuteCommand(args, context) = + if signatureHelpBroker.IsSignatureHelpActive(args.TextView) then + false + else if completionBroker.IsCompletionActive(args.TextView) then + false + else + let textView = args.TextView + let (controller: InteractivePadController) = downcast textView.Properties.[typeof] + controller.HistoryDown() + true diff --git a/vsintegration/src/FSharp.Editor/VSMac/InteractiveSession.fs b/vsintegration/src/FSharp.Editor/VSMac/InteractiveSession.fs new file mode 100644 index 00000000000..5571bc17c09 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/InteractiveSession.fs @@ -0,0 +1,188 @@ +namespace FSharp.Editor + +open System +open System.IO +open System.Diagnostics +open System.Runtime.Serialization.Formatters.Binary +open MonoDevelop.Core +open MonoDevelop.FSharp +open Newtonsoft.Json +open Microsoft.VisualStudio.FSharp.Editor.Extensions +open Newtonsoft.Json.Converters +open FSharp.Compiler.SourceCodeServices + +type CompletionData = { + displayText: string + completionText: string + category: string + [)>] + icon: Microsoft.CodeAnalysis.ExternalAccess.FSharp.FSharpGlyph + overloads: CompletionData array + description: string +} + +module binaryDeserializer = + let deserializeFromString<'T>(base64) = + match base64 with + | "" -> + None + | _ -> + let b = Convert.FromBase64String(base64) + use stream = new MemoryStream(b) + let formatter = new BinaryFormatter() + let (o:'T) = downcast formatter.Deserialize(stream) + Some o + +type InteractiveSession(pathToExe) = + let (|Completion|_|) (command: string) = + if command.StartsWith("completion ") then + let payload = command.[11..] + Some (JsonConvert.DeserializeObject payload) + else + None + + let (|Tooltip|_|) (command: string) = + if command.StartsWith("tooltip ") then + let payload = command.[8..] + Some (binaryDeserializer.deserializeFromString payload) + else + None + + let (|ParameterHints|_|) (command: string) = + if command.StartsWith("parameter-hints ") then + let payload = command.[16..] + Some (binaryDeserializer.deserializeFromString<(FSharpNoteworthyParamInfoLocations * FSharpMethodGroup)> payload) + else + None + + let (|Image|_|) (command: string) = + if command.StartsWith("image ") then + let base64image = command.[6..command.Length - 1] + let bytes = Convert.FromBase64String base64image + use ms = new MemoryStream(bytes) + Some (Xwt.Drawing.Image.FromStream ms) + else + None + + let (|ServerPrompt|_|) (command:string) = + if command = "SERVER-PROMPT>" then + Some () + else + None + + let textReceived = Event<_>() + let promptReady = Event<_>() + + let completionsReceivedEvent = new Event() + let imageReceivedEvent = new Event() + let tooltipReceivedEvent = new Event() + let parameterHintReceivedEvent = new Event<(FSharpNoteworthyParamInfoLocations * FSharpMethodGroup) option>() + + let mutable hasStarted = false + let startProcess() = + let processPid = sprintf " %d" (Process.GetCurrentProcess().Id) + + let processName = + if Environment.runningOnMono then Environment.getMonoPath() else pathToExe + + let arguments = + if Environment.runningOnMono then pathToExe + processPid else processPid + + let startInfo = + new ProcessStartInfo + (FileName = processName, UseShellExecute = false, Arguments = arguments, + RedirectStandardError = true, CreateNoWindow = true, RedirectStandardOutput = true, + RedirectStandardInput = true, StandardErrorEncoding = Text.Encoding.UTF8, StandardOutputEncoding = Text.Encoding.UTF8) + + try + let proc = Process.Start(startInfo) + LoggingService.logDebug "Process started %d" proc.Id + proc.BeginOutputReadLine() + proc.BeginErrorReadLine() + + proc.OutputDataReceived + |> Event.filter (fun de -> de.Data <> null) + |> Event.add (fun de -> + LoggingService.logDebug "Interactive: received %s" de.Data + Console.WriteLine de.Data + match de.Data with + | Image image -> imageReceivedEvent.Trigger image + | ServerPrompt -> promptReady.Trigger() + | data -> + if data.Trim() <> "" then + textReceived.Trigger(data + "\n")) + + proc.ErrorDataReceived.Subscribe(fun de -> + if not (String.IsNullOrEmpty de.Data) then + try + match de.Data with + | Completion completions -> + completionsReceivedEvent.Trigger completions + | Tooltip tooltip -> + tooltipReceivedEvent.Trigger tooltip + | ParameterHints hints -> + parameterHintReceivedEvent.Trigger hints + | _ -> LoggingService.logDebug "[fsharpi] don't know how to process command %s" de.Data + + with + | :? JsonException as e -> + LoggingService.logError "[fsharpi] - error deserializing error stream - %s\\n %s" e.Message de.Data + ) |> ignore + + proc.EnableRaisingEvents <- true + hasStarted <- true + proc + with e -> + LoggingService.logDebug "Interactive: Error %s" (e.ToString()) + reraise() + + let mutable fsiProcess = Unchecked.defaultof + + let sendCommand(str:string) = + LoggingService.logDebug "Interactive: sending %s" str + LoggingService.logDebug "send command %d" fsiProcess.Id + + async { + let stream = fsiProcess.StandardInput.BaseStream + let bytes = Text.Encoding.UTF8.GetBytes(str + "\n") + do! stream.WriteAsync(bytes,0,bytes.Length) |> Async.AwaitTask + stream.Flush() + } |> Async.Start + + member x.Interrupt() = + LoggingService.logDebug "Interactive: Break!" + + member x.CompletionsReceived = completionsReceivedEvent.Publish + member x.TooltipReceived = tooltipReceivedEvent.Publish + member x.ParameterHintReceived = parameterHintReceivedEvent.Publish + member x.ImageReceived = imageReceivedEvent.Publish + member x.TextReceived = textReceived.Publish + member x.PromptReady = promptReady.Publish + member x.StartReceiving() = fsiProcess <- startProcess() + + member x.HasStarted = hasStarted + member x.HasExited() = fsiProcess.HasExited + member x.Kill() = fsiProcess.Kill() + member x.Restart() = + fsiProcess.Kill() + fsiProcess <- startProcess() + + member x.SendInput input documentName = + printfn "%s" input + documentName + |> Option.iter(fun fileName -> + sendCommand (sprintf "input # 0 @\"%s\"" fileName)) + + for line in String.getLines input do + sendCommand ("input " + line) + + member x.SendCompletionRequest input column = + sendCommand (sprintf "completion %d %s" column input) + + member x.SendParameterHintRequest input column = + sendCommand (sprintf "parameter-hints %d %s" column input) + + member x.SendTooltipRequest input = + sendCommand (sprintf "tooltip %s" input) + + member x.Exited = fsiProcess.Exited diff --git a/vsintegration/src/FSharp.Editor/VSMac/InteractiveWorkspace.fs b/vsintegration/src/FSharp.Editor/VSMac/InteractiveWorkspace.fs new file mode 100644 index 00000000000..0c4e7ec01b8 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/InteractiveWorkspace.fs @@ -0,0 +1,60 @@ +// +// InteractiveWorkspace.fs +// +// Author: +// jasonimison +// +// Copyright (c) 2020 Microsoft +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +// THE SOFTWARE. +namespace FSharp.Editor + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Text +open Microsoft.VisualStudio.Text +open MonoDevelop.Ide.Composition + +type InteractiveWorkspace() = + inherit Workspace(CompositionManager.Instance.HostServices, WorkspaceKind.MiscellaneousFiles) with + member x.CreateDocument(buffer: ITextBuffer) = + let projectId = ProjectId.CreateNewId() + let name = "interactive.fsx" + let documentId = DocumentId.CreateNewId(projectId, name) + let container = buffer.AsTextContainer() + + let projectInfo = + ProjectInfo.Create( + projectId, + VersionStamp.Create(), + name = name, + assemblyName = "interactive.dll", + language = "F# Interactive") + + base.OnProjectAdded(projectInfo) + let documentInfo = + DocumentInfo.Create( + documentId, + name, + Array.empty, + sourceCodeKind = SourceCodeKind.Script, + filePath = name, + loader = TextLoader.From(buffer.AsTextContainer(), VersionStamp.Create())) + + base.OnDocumentAdded(documentInfo) + base.OnDocumentOpened(documentId, container) diff --git a/vsintegration/src/FSharp.Editor/VSMac/PortableFSharpProjectFlavor.fs b/vsintegration/src/FSharp.Editor/VSMac/PortableFSharpProjectFlavor.fs new file mode 100644 index 00000000000..d7d593a67d2 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/PortableFSharpProjectFlavor.fs @@ -0,0 +1,9 @@ +namespace FSharp.Editor + +open MonoDevelop.Projects + +type PortableFSharpProjectFlavor() = + inherit PortableDotNetProjectFlavor() + + override x.OnGetDefaultImports imports = + imports.Add @"$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.Portable.FSharp.Targets" diff --git a/vsintegration/src/FSharp.Editor/VSMac/SignatureHelp.fs b/vsintegration/src/FSharp.Editor/VSMac/SignatureHelp.fs new file mode 100644 index 00000000000..cb45fa4023e --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/SignatureHelp.fs @@ -0,0 +1,206 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor +open System +open System.ComponentModel.Composition +open System.Collections.Generic + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Text +open Microsoft.CodeAnalysis.ExternalAccess.FSharp.SignatureHelp + +open Microsoft.VisualStudio.Text + +open FSharp.Compiler.Layout +open FSharp.Compiler.Range +open FSharp.Compiler.SourceCodeServices + +[] +[)>] +type internal FSharpInteractiveSignatureHelpProvider + [] + ( + ) = + + static let userOpName = "SignatureHelpProvider" + let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder() + + static let oneColAfter (lp: LinePosition) = LinePosition(lp.Line,lp.Character+1) + static let oneColBefore (lp: LinePosition) = LinePosition(lp.Line,max 0 (lp.Character-1)) + + // Unit-testable core routine + static member internal ProvideMethodsAsyncAux(nwpl:FSharpNoteworthyParamInfoLocations, methodGroup:FSharpMethodGroup, documentationBuilder: IDocumentationBuilder, sourceText: SourceText, caretPosition: int, triggerIsTypedChar: char option) = async { + + let textLines = sourceText.Lines + let caretLinePos = textLines.GetLinePosition(caretPosition) + + let methods = methodGroup.Methods + + if (methods.Length = 0 || methodGroup.MethodName.EndsWith("> )")) then return None else + + let isStaticArgTip = + let parenLine, parenCol = Pos.toZ nwpl.OpenParenLocation + assert (parenLine < textLines.Count) + let parenLineText = textLines.[parenLine].ToString() + parenCol < parenLineText.Length && parenLineText.[parenCol] = '<' + + let filteredMethods = + [| for m in methods do + if (isStaticArgTip && m.StaticParameters.Length > 0) || + (not isStaticArgTip && m.HasParameters) then // need to distinguish TP<...>(...) angle brackets tip from parens tip + yield m |] + + if filteredMethods.Length = 0 then return None else + + let posToLinePosition pos = + let (l,c) = Pos.toZ pos + // FSROSLYNTODO: FCS gives back line counts that are too large. Really, this shouldn't happen + let result =LinePosition(l,c) + let lastPosInDocument = textLines.GetLinePosition(textLines.[textLines.Count-1].End) + if lastPosInDocument.CompareTo(result) > 0 then result else lastPosInDocument + + // Compute the start position + let startPos = nwpl.LongIdStartLocation |> posToLinePosition + + // Compute the end position + let endPos = + let last = nwpl.TupleEndLocations.[nwpl.TupleEndLocations.Length-1] |> posToLinePosition + (if nwpl.IsThereACloseParen then oneColBefore last else last) + + assert (startPos.CompareTo(endPos) <= 0) + + // Compute the applicable span between the parentheses + let applicableSpan = + textLines.GetTextSpan(LinePositionSpan(startPos, endPos)) + + let startOfArgs = nwpl.OpenParenLocation |> posToLinePosition |> oneColAfter + + let tupleEnds = + [| yield startOfArgs + for i in 0..nwpl.TupleEndLocations.Length-2 do + yield nwpl.TupleEndLocations.[i] |> posToLinePosition + yield endPos |] + + // If we are pressing "(" or "<" or ",", then only pop up the info if this is one of the actual, real detected positions in the detected promptable call + // + // For example the last "(" in + // List.map (fun a -> ( + // should not result in a prompt. + // + // Likewise the last "," in + // Console.WriteLine( [(1, + // should not result in a prompt, whereas this one will: + // Console.WriteLine( [(1,2)], + + //match triggerIsTypedChar with + //| Some ('<' | '(' | ',') when not (tupleEnds |> Array.exists (fun lp -> lp.Character = caretLineColumn)) -> + // return None // comma or paren at wrong location = remove help display + //| _ -> + + // Compute the argument index by working out where the caret is between the various commas. + let argumentIndex = + let computedTextSpans = + tupleEnds + |> Array.pairwise + |> Array.map (fun (lp1, lp2) -> textLines.GetTextSpan(LinePositionSpan(lp1, lp2))) + + match (computedTextSpans|> Array.tryFindIndex (fun t -> t.Contains(caretPosition))) with + | None -> + // Because 'TextSpan.Contains' only succeeds if 'TextSpan.Start <= caretPosition < TextSpan.End' is true, + // we need to check if the caret is at the very last position in the TextSpan. + // + // We default to 0, which is the first argument, if the caret position was nowhere to be found. + if computedTextSpans.[computedTextSpans.Length-1].End = caretPosition then + computedTextSpans.Length-1 + else 0 + | Some n -> n + + // Compute the overall argument count + let argumentCount = + match nwpl.TupleEndLocations.Length with + | 1 when caretLinePos.Character = startOfArgs.Character -> 0 // count "WriteLine(" as zero arguments + | n -> n + + // Compute the current argument name, if any + let argumentName = + if argumentIndex < nwpl.NamedParamNames.Length then + nwpl.NamedParamNames.[argumentIndex] + else + None // not a named argument + + // Prepare the results + let results = ResizeArray() + + for method in methods do + // Create the documentation. Note, do this on the background thread, since doing it in the documentationBuild fails to build the XML index + let mainDescription = ResizeArray() + let documentation = ResizeArray() + XmlDocumentation.BuildMethodOverloadTipText(documentationBuilder, RoslynHelpers.CollectTaggedText mainDescription, RoslynHelpers.CollectTaggedText documentation, method.StructuredDescription, false) + + let parameters = + let parameters = if isStaticArgTip then method.StaticParameters else method.Parameters + [| for p in parameters do + let doc = List() + // FSROSLYNTODO: compute the proper help text for parameters, c.f. AppendParameter in XmlDocumentation.fs + XmlDocumentation.BuildMethodParamText(documentationBuilder, RoslynHelpers.CollectTaggedText doc, method.XmlDoc, p.ParameterName) + let parts = List() + renderL (taggedTextListR (RoslynHelpers.CollectTaggedText parts)) p.StructuredDisplay |> ignore + yield (p.ParameterName, p.IsOptional, p.CanonicalTypeTextForSorting, doc, parts) + |] + + let prefixParts = + [| TaggedText(TextTags.Method, methodGroup.MethodName); + TaggedText(TextTags.Punctuation, (if isStaticArgTip then "<" else "(")) |] + let separatorParts = [| TaggedText(TextTags.Punctuation, ","); TaggedText(TextTags.Space, " ") |] + let suffixParts = [| TaggedText(TextTags.Punctuation, (if isStaticArgTip then ">" else ")")) |] + + let completionItem = (method.HasParamArrayArg, documentation, prefixParts, separatorParts, suffixParts, parameters, mainDescription) + results.Add(completionItem) + + + let items = (results.ToArray(),applicableSpan,argumentIndex,argumentCount,argumentName) + return Some items + } + + interface IFSharpInteractiveSignatureHelpProvider with + member this.GetItemsAsync(document, position, triggerInfo, cancellationToken) = + asyncMaybe { + try + let! fsi = FSharpInteractivePad.Fsi + let! controller = fsi.Controller + let! sourceText = document.GetTextAsync(cancellationToken) + let line = sourceText.Lines.GetLineFromPosition(position) + let column = position - line.Start + let snapshot = sourceText.FindCorrespondingEditorTextSnapshot() + let lineText = snapshot.GetText(Span(line.Start, line.End - line.Start)) + MonoDevelop.Core.LoggingService.LogDebug("parameter-hints " + column.ToString() + " " + lineText) + controller.Session.SendParameterHintRequest lineText column + + let! paramInfo, methodGroups = controller.Session.ParameterHintReceived |> Async.AwaitEvent + let triggerTypedChar = + if triggerInfo.TriggerCharacter.HasValue && triggerInfo.TriggerReason = FSharpSignatureHelpTriggerReason.TypeCharCommand then + Some triggerInfo.TriggerCharacter.Value + else None + + let! (results,applicableSpan,argumentIndex,argumentCount,argumentName) = + FSharpInteractiveSignatureHelpProvider.ProvideMethodsAsyncAux(paramInfo, methodGroups, documentationBuilder, sourceText, column, triggerTypedChar) + let items = + results + |> Array.map (fun (hasParamArrayArg, doc, prefixParts, separatorParts, suffixParts, parameters, descriptionParts) -> + let parameters = parameters + |> Array.map (fun (paramName, isOptional, _typeText, paramDoc, displayParts) -> + FSharpSignatureHelpParameter(paramName,isOptional,documentationFactory=(fun _ -> paramDoc :> seq<_>),displayParts=displayParts)) + FSharpSignatureHelpItem(isVariadic=hasParamArrayArg, documentationFactory=(fun _ -> doc :> seq<_>),prefixParts=prefixParts,separatorParts=separatorParts,suffixParts=suffixParts,parameters=parameters,descriptionParts=descriptionParts)) + + // The text span that comes back from FCS always has line number 1. We need to map this back to the + // actual line number in the editor + let offset = position - column + let applicableAdjustedSpan = + new TextSpan(applicableSpan.Start + offset, applicableSpan.End - applicableSpan.Start - 1) + return FSharpSignatureHelpItems(items,applicableAdjustedSpan,argumentIndex,argumentCount,Option.toObj argumentName) + with ex -> + Assert.Exception(ex) + return! None + } + |> Async.map Option.toObj + |> RoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/AssemblyInfo.xft.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/AssemblyInfo.xft.xml new file mode 100644 index 00000000000..909fd3774e2 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/AssemblyInfo.xft.xml @@ -0,0 +1,45 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpScript.xft.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpScript.xft.xml new file mode 100644 index 00000000000..430b9ab2be4 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpScript.xft.xml @@ -0,0 +1,18 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpSignature.xft.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpSignature.xft.xml new file mode 100644 index 00000000000..8f6627dfeb9 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpSignature.xft.xml @@ -0,0 +1,22 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpSource.xft.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpSource.xft.xml new file mode 100644 index 00000000000..ee9b706bb41 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/EmptyFSharpSource.xft.xml @@ -0,0 +1,18 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharp-templates.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharp-templates.xml new file mode 100644 index 00000000000..b88b14728e3 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharp-templates.xml @@ -0,0 +1,462 @@ + + + +
+ <_Group>F# + + text/x-fsharp + agent + <_Description>Creates boilerplate code for an agent + Unknown +
+ + + myAgent + + + string + + + (fun inbox -> + let rec loop () = + async { + let! msg = inbox.Receive() + return! loop () } + loop ()) +$end$]]> + + + +
+ <_Group>F# + + text/x-fsharp + outlet + <_Description>Creates an iOS outlet with attribute + Unknown +
+ + + Name + + + UILabel + + + ] +member val $name$ : $type$ = null with get, set]]> + + + +
+ <_Group>F# + + text/x-fsharp + action + <_Description>Creates an iOS action with attribute + Unknown +
+ + + Name + + + NSObject + + + ] +member this.$name$ (sender : $type$) = + $end$]]> + + + +
+ <_Group>F# + + text/x-fsharp + uncheck + <_Description>Creates an unchecked default value + Unknown +
+ + + type + + + ]]> + + + +
+ <_Group>F# + + text/x-fsharp + check + <_Description>Checks variable type + Expansion +
+ + + name + + + type + + + () +| _ -> ()]]> + + + +
+ <_Group>F# + + text/x-fsharp + virt + <_Description>Adds a virtual member + Expansion +
+ + + name + + + delta + + + unit +default this.$funName$ (delta:int) = ()]]> + + + +
+ <_Group>F# + + text/x-fsharp + abstract + <_Description>Creates an abstract method + Expansion +
+ + + name + + + parameters + + + + + + +
+ <_Group>F# + + text/x-fsharp + abstractp + <_Description>Creates an abstract property + Expansion +
+ + + name + + + int + + + + + + +
+ <_Group>F# + + text/x-fsharp + seq + <_Description>Creates a sequence + Unknown +
+ + + + + +
+ <_Group>F# + + text/x-fsharp + list + <_Description>Creates a list + Unknown +
+ + + name + + + + + + +
+ <_Group>F# + + text/x-fsharp + array + <_Description>Creates an array + Unknown +
+ + + name + + + + + + +
+ <_Group>F# + + text/x-fsharp + struct + <_Description>Creates a struct + Expansion +
+ + + name + + + ] +type $name$ = + $end$]]> + + + +
+ <_Group>F# + + text/x-fsharp + if + <_Description>Template for if...then + Expansion +
+ + + condition + + + + + + +
+ <_Group>F# + + text/x-fsharp + elif + <_Description>Template for elif...then + Expansion +
+ + + condition + + + + + + +
+ <_Group>F# + + text/x-fsharp + ifelse + <_Description>Template for if...then...else + Expansion +
+ + + condition + + + + + + +
+ <_Group>F# + + text/x-fsharp + while + <_Description>Template for while + Expansion +
+ + + condition + + + > + + + +
+ <_Group>F# + + text/x-fsharp + fort + <_Description>Template for for...to + Expansion +
+ + + identifier + + + start + + + finish + + + + + + +
+ <_Group>F# + + text/x-fsharp + fordt + <_Description>Template for for...downto + Expansion +
+ + + identifier + + + start + + + finish + + + + + + +
+ <_Group>F# + + text/x-fsharp + fori + <_Description>Template for for...in + Expansion +
+ + + pattern + + + expression + + + + + + +
+ <_Group>F# + + text/x-fsharp + match + <_Description>Template for match + Expansion +
+ + + expression + + + pattern + + + $end$]]> + + + +
+ <_Group>F# + + text/x-fsharp + fun + <_Description>Template for fun + Expansion +
+ + + () + + + expression + + + $expression$ $end$]]> + + + +
+ <_Group>F# + + text/x-fsharp + main + <_Description>Template for main + Expansion +
+ + + main + + + ] +let $name$ argv = + printfn "%A" argv + 0]]> + + + +
+ <_Group>F# + + text/x-fsharp + tomap + <_Description>Converts dictionary to F# map + Expansion +
+ + + toMap + + + ) = + dictionary + |> Seq.map (|KeyValue|) + |> Map.ofSeq +$end$]]> + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpConsoleProject.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpConsoleProject.xpt.xml new file mode 100644 index 00000000000..aee501369cd --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpConsoleProject.xpt.xml @@ -0,0 +1,51 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpGtkProject.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpGtkProject.xpt.xml new file mode 100644 index 00000000000..fc1a242bced --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpGtkProject.xpt.xml @@ -0,0 +1,86 @@ + + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpLibraryProject.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpLibraryProject.xpt.xml new file mode 100644 index 00000000000..ad788321f02 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpLibraryProject.xpt.xml @@ -0,0 +1,55 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpNUnitLibraryProject.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpNUnitLibraryProject.xpt.xml new file mode 100644 index 00000000000..b205419510a --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpNUnitLibraryProject.xpt.xml @@ -0,0 +1,58 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpNUnitTestType.xft.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpNUnitTestType.xft.xml new file mode 100644 index 00000000000..a165d4888d6 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpNUnitTestType.xft.xml @@ -0,0 +1,31 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpTutorialProject.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpTutorialProject.xpt.xml new file mode 100644 index 00000000000..865305b0929 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/FSharpTutorialProject.xpt.xml @@ -0,0 +1,1019 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/PortableLibrary.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/PortableLibrary.xpt.xml new file mode 100644 index 00000000000..9ec8583bf10 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/PortableLibrary.xpt.xml @@ -0,0 +1,58 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/SharedAssetsProject.xpt.xml b/vsintegration/src/FSharp.Editor/VSMac/templates/SharedAssetsProject.xpt.xml new file mode 100644 index 00000000000..e2cfa1e9019 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/SharedAssetsProject.xpt.xml @@ -0,0 +1,36 @@ + + diff --git a/vsintegration/src/FSharp.Editor/VSMac/templates/templates.targets b/vsintegration/src/FSharp.Editor/VSMac/templates/templates.targets new file mode 100644 index 00000000000..d7130fbd765 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/VSMac/templates/templates.targets @@ -0,0 +1,43 @@ + + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + PreserveNewest + + + \ No newline at end of file