diff --git a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj index 015f7f23d82..abcca2ff436 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj +++ b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj @@ -553,6 +553,9 @@ Service/ServiceAssemblyContent.fs + + Service/ServiceXmlDocParser.fs + Service/service.fsi diff --git a/src/fsharp/vs/ServiceInterfaceStubGenerator.fs b/src/fsharp/vs/ServiceInterfaceStubGenerator.fs index 0d385afb0b8..b93b2230c91 100644 --- a/src/fsharp/vs/ServiceInterfaceStubGenerator.fs +++ b/src/fsharp/vs/ServiceInterfaceStubGenerator.fs @@ -1,4 +1,6 @@ -namespace Microsoft.FSharp.Compiler.SourceCodeServices +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Compiler.SourceCodeServices open System open System.Diagnostics @@ -7,98 +9,6 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.SourceCodeServices - -[] -[] -module Array = - /// pass an array byref to reverse it in place - let revInPlace (array: 'T []) = - if Array.isEmpty array then () else - let arrlen, revlen = array.Length-1, array.Length/2 - 1 - for idx in 0 .. revlen do - let t1 = array.[idx] - let t2 = array.[arrlen-idx] - array.[idx] <- t2 - array.[arrlen-idx] <- t1 - - /// Async implementation of Array.map. - let mapAsync (mapping : 'T -> Async<'U>) (array : 'T[]) : Async<'U[]> = - let len = Array.length array - let result = Array.zeroCreate len - - async { // Apply the mapping function to each array element. - for i in 0 .. len - 1 do - let! mappedValue = mapping array.[i] - result.[i] <- mappedValue - - // Return the completed results. - return result - } - -[] -[] -module String = - open System.IO - - let inline toCharArray (str: string) = str.ToCharArray() - - let lowerCaseFirstChar (str: string) = - if String.IsNullOrEmpty str - || Char.IsLower(str, 0) then str else - let strArr = toCharArray str - match Array.tryHead strArr with - | None -> str - | Some c -> - strArr.[0] <- Char.ToLower c - String (strArr) - - let extractTrailingIndex (str: string) = - match str with - | null -> null, None - | _ -> - let charr = str.ToCharArray() - Array.revInPlace charr - let digits = Array.takeWhile Char.IsDigit charr - Array.revInPlace digits - String digits - |> function - | "" -> str, None - | index -> str.Substring (0, str.Length - index.Length), Some (int index) - - /// Remove all trailing and leading whitespace from the string - /// return null if the string is null - let trim (value: string) = if isNull value then null else value.Trim() - - /// Splits a string into substrings based on the strings in the array separators - let split options (separator: string []) (value: string) = - if isNull value then null else value.Split(separator, options) - - let (|StartsWith|_|) pattern value = - if String.IsNullOrWhiteSpace value then - None - elif value.StartsWith pattern then - Some() - else None - - let (|Contains|_|) pattern value = - if String.IsNullOrWhiteSpace value then - None - elif value.Contains pattern then - Some() - else None - - let getLines (str: string) = - use reader = new StringReader(str) - [| - let line = ref (reader.ReadLine()) - while not (isNull !line) do - yield !line - line := reader.ReadLine() - if str.EndsWith("\n") then - // last trailing space not returned - // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak - yield String.Empty - |] [] module internal CodeGenerationUtils = diff --git a/src/fsharp/vs/ServiceXmlDocParser.fs b/src/fsharp/vs/ServiceXmlDocParser.fs new file mode 100644 index 00000000000..21c338506b6 --- /dev/null +++ b/src/fsharp/vs/ServiceXmlDocParser.fs @@ -0,0 +1,284 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Compiler.SourceCodeServices + +[] +[] +module Array = + /// pass an array byref to reverse it in place + let revInPlace (array: 'T []) = + if Array.isEmpty array then () else + let arrlen, revlen = array.Length-1, array.Length/2 - 1 + for idx in 0 .. revlen do + let t1 = array.[idx] + let t2 = array.[arrlen-idx] + array.[idx] <- t2 + array.[arrlen-idx] <- t1 + + /// Async implementation of Array.map. + let mapAsync (mapping : 'T -> Async<'U>) (array : 'T[]) : Async<'U[]> = + let len = Array.length array + let result = Array.zeroCreate len + + async { // Apply the mapping function to each array element. + for i in 0 .. len - 1 do + let! mappedValue = mapping array.[i] + result.[i] <- mappedValue + + // Return the completed results. + return result + } + +[] +[] +module String = + open System + open System.IO + + let inline toCharArray (str: string) = str.ToCharArray() + + let lowerCaseFirstChar (str: string) = + if String.IsNullOrEmpty str + || Char.IsLower(str, 0) then str else + let strArr = toCharArray str + match Array.tryHead strArr with + | None -> str + | Some c -> + strArr.[0] <- Char.ToLower c + String (strArr) + + let extractTrailingIndex (str: string) = + match str with + | null -> null, None + | _ -> + let charr = str.ToCharArray() + Array.revInPlace charr + let digits = Array.takeWhile Char.IsDigit charr + Array.revInPlace digits + String digits + |> function + | "" -> str, None + | index -> str.Substring (0, str.Length - index.Length), Some (int index) + + /// Remove all trailing and leading whitespace from the string + /// return null if the string is null + let trim (value: string) = if isNull value then null else value.Trim() + + /// Splits a string into substrings based on the strings in the array separators + let split options (separator: string []) (value: string) = + if isNull value then null else value.Split(separator, options) + + let (|StartsWith|_|) pattern value = + if String.IsNullOrWhiteSpace value then + None + elif value.StartsWith pattern then + Some() + else None + + let (|Contains|_|) pattern value = + if String.IsNullOrWhiteSpace value then + None + elif value.Contains pattern then + Some() + else None + + let getLines (str: string) = + use reader = new StringReader(str) + [| + let line = ref (reader.ReadLine()) + while not (isNull !line) do + yield !line + line := reader.ReadLine() + if str.EndsWith("\n") then + // last trailing space not returned + // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak + yield String.Empty + |] + +/// Represent an Xml documentation block in source code +type XmlDocable = + | XmlDocable of line:int * indent:int * paramNames:string list + +module internal XmlDocParsing = + open Microsoft.FSharp.Compiler.Range + open Microsoft.FSharp.Compiler.Ast + + let (|ConstructorPats|) = function + | Pats ps -> ps + | NamePatPairs(xs, _) -> List.map snd xs + + let rec digNamesFrom = function + | SynPat.Named(_innerPat,id,_isTheThisVar,_access,_range) -> [id.idText] + | SynPat.Typed(pat,_type,_range) -> digNamesFrom pat + | SynPat.Attrib(pat,_attrs,_range) -> digNamesFrom pat + | SynPat.LongIdent(_lid,_idOpt,_typDeclsOpt,ConstructorPats pats,_access,_range) -> + pats |> List.collect digNamesFrom + | SynPat.Tuple(pats,_range) + | SynPat.StructTuple(pats,_range) -> pats |> List.collect digNamesFrom + | SynPat.Paren(pat,_range) -> digNamesFrom pat + | SynPat.OptionalVal (id, _) -> [id.idText] + | SynPat.Or _ // no one uses ors in fun decls + | SynPat.Ands _ // no one uses ands in fun decls + | SynPat.ArrayOrList _ // no one uses this in fun decls + | SynPat.Record _ // no one uses this in fun decls + | SynPat.Null _ + | SynPat.Const _ + | SynPat.Wild _ + | SynPat.IsInst _ + | SynPat.QuoteExpr _ + | SynPat.DeprecatedCharRange _ + | SynPat.InstanceMember _ + | SynPat.FromParseError _ -> [] + + let getXmlDocablesImpl(sourceCodeLinesOfTheFile: string [], input: ParsedInput option) = + let indentOf (lineNum: int) = + let mutable i = 0 + let line = sourceCodeLinesOfTheFile.[lineNum-1] // -1 because lineNum reported by xmldocs are 1-based, but array is 0-based + while i < line.Length && line.Chars(i) = ' ' do + i <- i + 1 + i + + let isEmptyXmlDoc (preXmlDoc: PreXmlDoc) = + match preXmlDoc.ToXmlDoc() with + | XmlDoc [||] -> true + | XmlDoc [|x|] when x.Trim() = "" -> true + | _ -> false + + let rec getXmlDocablesSynModuleDecl = function + | SynModuleDecl.NestedModule(_, _, synModuleDecls, _, _) -> + (synModuleDecls |> List.collect getXmlDocablesSynModuleDecl) + | SynModuleDecl.Let(_, synBindingList, range) -> + let anyXmlDoc = + synBindingList |> List.exists (fun (SynBinding.Binding(_, _, _, _, _, preXmlDoc, _, _, _, _, _, _)) -> + not <| isEmptyXmlDoc preXmlDoc) + if anyXmlDoc then [] else + let synAttributes = + synBindingList |> List.collect (fun (SynBinding.Binding(_, _, _, _, a, _, _, _, _, _, _, _)) -> a) + let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range + let line = fullRange.StartLine + let indent = indentOf line + [ for SynBinding.Binding(_, _, _, _, _, _, synValData, synPat, _, _, _, _) in synBindingList do + match synValData with + | SynValData(_memberFlagsOpt, SynValInfo(args, _), _) when not (List.isEmpty args) -> + let parameters = + args + |> List.collect ( + List.collect (fun (SynArgInfo(_, _, ident)) -> + match ident with + | Some ident -> [ident.idText] + | None -> [])) + match parameters with + | [] -> + let paramNames = digNamesFrom synPat + yield! paramNames + | _ :: _ -> + yield! parameters + | _ -> () ] + |> fun paramNames -> [ XmlDocable(line,indent,paramNames) ] + | SynModuleDecl.Types(synTypeDefnList, _) -> (synTypeDefnList |> List.collect getXmlDocablesSynTypeDefn) + | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> getXmlDocablesSynModuleOrNamespace synModuleOrNamespace + | SynModuleDecl.ModuleAbbrev _ + | SynModuleDecl.DoExpr _ + | SynModuleDecl.Exception _ + | SynModuleDecl.Open _ + | SynModuleDecl.Attributes _ + | SynModuleDecl.HashDirective _ -> [] + + and getXmlDocablesSynModuleOrNamespace (SynModuleOrNamespace(_, _, _, synModuleDecls, _, _, _, _)) = + (synModuleDecls |> List.collect getXmlDocablesSynModuleDecl) + + and getXmlDocablesSynTypeDefn (SynTypeDefn.TypeDefn(ComponentInfo(synAttributes, _, _, _, preXmlDoc, _, _, compRange), synTypeDefnRepr, synMemberDefns, tRange)) = + let stuff = + match synTypeDefnRepr with + | SynTypeDefnRepr.ObjectModel(_, synMemberDefns, _) -> (synMemberDefns |> List.collect getXmlDocablesSynMemberDefn) + | SynTypeDefnRepr.Simple(_synTypeDefnSimpleRepr, _range) -> [] + | SynTypeDefnRepr.Exception _ -> [] + let docForTypeDefn = + if isEmptyXmlDoc preXmlDoc then + let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) (unionRanges compRange tRange) + let line = fullRange.StartLine + let indent = indentOf line + [XmlDocable(line,indent,[])] + else [] + docForTypeDefn @ stuff @ (synMemberDefns |> List.collect getXmlDocablesSynMemberDefn) + + and getXmlDocablesSynMemberDefn = function + | SynMemberDefn.Member(SynBinding.Binding(_, _, _, _, synAttributes, preXmlDoc, _, synPat, _, _, _, _), memRange) -> + if isEmptyXmlDoc preXmlDoc then + let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) memRange + let line = fullRange.StartLine + let indent = indentOf line + let paramNames = digNamesFrom synPat + [XmlDocable(line,indent,paramNames)] + else [] + | SynMemberDefn.AbstractSlot(ValSpfn(synAttributes, _, _, _, SynValInfo(args, _), _, _, preXmlDoc, _, _, _), _, range) -> + if isEmptyXmlDoc preXmlDoc then + let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range + let line = fullRange.StartLine + let indent = indentOf line + let paramNames = args |> List.collect (fun az -> az |> List.choose (fun (SynArgInfo(_synAttributes, _, idOpt)) -> match idOpt with | Some id -> Some(id.idText) | _ -> None)) + [XmlDocable(line,indent,paramNames)] + else [] + | SynMemberDefn.Interface(_synType, synMemberDefnsOption, _range) -> + match synMemberDefnsOption with + | None -> [] + | Some(x) -> x |> List.collect getXmlDocablesSynMemberDefn + | SynMemberDefn.NestedType(synTypeDefn, _, _) -> getXmlDocablesSynTypeDefn synTypeDefn + | SynMemberDefn.AutoProperty(synAttributes, _, _, _, _, _, _, _, _, _, range) -> + let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range + let line = fullRange.StartLine + let indent = indentOf line + [XmlDocable(line, indent, [])] + | SynMemberDefn.Open _ + | SynMemberDefn.ImplicitCtor _ + | SynMemberDefn.ImplicitInherit _ + | SynMemberDefn.Inherit _ + | SynMemberDefn.ValField _ + | SynMemberDefn.LetBindings _ -> [] + + and getXmlDocablesInput input = + match input with + | ParsedInput.ImplFile(ParsedImplFileInput(_, _, _, _, _, symModules, _))-> + symModules |> List.collect getXmlDocablesSynModuleOrNamespace + | ParsedInput.SigFile _ -> [] + + async { + // Get compiler options for the 'project' implied by a single script file + match input with + | Some input -> + return getXmlDocablesInput input + | None -> + // Should not fail here, just in case + return [] + } + +module internal XmlDocComment = + let private ws (s: string, pos) = + let res = s.TrimStart() + Some (res, pos + (s.Length - res.Length)) + + let private str (prefix: string) (s: string, pos) = + match s.StartsWith prefix with + | true -> + let res = s.Substring prefix.Length + Some (res, pos + (s.Length - res.Length)) + | _ -> None + + let private eol (s: string, pos) = + match s with + | "" -> Some ("", pos) + | _ -> None + + let inline private (>=>) f g = f >> Option.bind g + + // if it's a blank XML comment with trailing "<", returns Some (index of the "<"), otherwise returns None + let isBlank (s: string) = + let parser = ws >=> str "///" >=> ws >=> str "<" >=> eol + let res = parser (s.TrimEnd(), 0) |> Option.map snd |> Option.map (fun x -> x - 1) + res + +module internal XmlDocParser = + /// Get the list of Xml documentation from current source code + let getXmlDocables (sourceCodeOfTheFile, input) = + let sourceCodeLinesOfTheFile = String.getLines sourceCodeOfTheFile + XmlDocParsing.getXmlDocablesImpl (sourceCodeLinesOfTheFile, input) \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs index 574d7add6b7..59b39547f00 100644 --- a/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs +++ b/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs @@ -1,4 +1,6 @@ -namespace Microsoft.VisualStudio.FSharp.Editor +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor open System open Microsoft.VisualStudio.Text.Editor diff --git a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs new file mode 100644 index 00000000000..51fcb52d4eb --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs @@ -0,0 +1,136 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.OLE.Interop +open System.ComponentModel.Composition +open Microsoft.VisualStudio +open Microsoft.VisualStudio.Editor +open Microsoft.VisualStudio.Text +open Microsoft.VisualStudio.TextManager.Interop +open Microsoft.VisualStudio.Utilities +open Microsoft.VisualStudio.Shell +open Microsoft.VisualStudio.Shell.Interop +open Microsoft.VisualStudio.LanguageServices.Implementation.ProjectSystem +open Microsoft.FSharp.Compiler.SourceCodeServices +open Microsoft.VisualStudio.FSharp.LanguageService +open System.Runtime.InteropServices +open EnvDTE + +type internal XmlDocCommandFilter + ( + wpfTextView: IWpfTextView, + filePath: string, + checkerProvider: FSharpCheckerProvider, + projectInfoManager: ProjectInfoManager, + workspace: VisualStudioWorkspaceImpl + ) = + let checker = checkerProvider.Checker + + let document = + // There may be multiple documents with the same file path. + // However, for the purpose of generating XmlDoc comments, it is ok to keep only the first document. + lazy(match workspace.CurrentSolution.GetDocumentIdsWithFilePath(filePath) |> Seq.toList with + | [] -> None + | documentId :: _ -> Some (workspace.CurrentSolution.GetDocument documentId)) + + /// Get the char for a command. + let getTypedChar(pvaIn: IntPtr) = + char (Marshal.GetObjectForNativeVariant(pvaIn) :?> uint16) + + let mutable nextTarget = null + + member this.AttachToViewAdapter (viewAdapter: IVsTextView) = + match viewAdapter.AddCommandFilter this with + | VSConstants.S_OK, next -> + nextTarget <- next + | errorCode, _ -> + ErrorHandler.ThrowOnFailure errorCode |> ignore + + interface IOleCommandTarget with + member __.Exec(pguidCmdGroup: byref, nCmdID: uint32, nCmdexecopt: uint32, pvaIn: IntPtr, pvaOut: IntPtr) = + if pguidCmdGroup = VSConstants.VSStd2K && nCmdID = uint32 VSConstants.VSStd2KCmdID.TYPECHAR then + match getTypedChar pvaIn with + | ('/' | '<') as lastChar -> + let indexOfCaret = wpfTextView.Caret.Position.BufferPosition.Position + - wpfTextView.Caret.Position.BufferPosition.GetContainingLine().Start.Position + let curLine = wpfTextView.Caret.Position.BufferPosition.GetContainingLine().GetText() + let lineWithLastCharInserted = curLine.Insert (indexOfCaret, string lastChar) + + match XmlDocComment.isBlank lineWithLastCharInserted with + | Some i when i = indexOfCaret -> + async { + try + // XmlDocable line #1 are 1-based, editor is 0-based + let curLineNum = wpfTextView.Caret.Position.BufferPosition.GetContainingLine().LineNumber + 1 + match document.Value with + | None -> () + | Some document -> + match projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) with + | None -> () + | Some options -> + let sourceText = wpfTextView.TextBuffer.CurrentSnapshot.GetText() + let! parseResults = checker.ParseFileInProject(filePath, sourceText, options) + let! xmlDocables = XmlDocParser.getXmlDocables (sourceText, parseResults.ParseTree) + let xmlDocablesBelowThisLine = + // +1 because looking below current line for e.g. a 'member' + xmlDocables |> List.filter (fun (XmlDocable(line,_indent,_paramNames)) -> line = curLineNum+1) + match xmlDocablesBelowThisLine with + | [] -> () + | XmlDocable(_line,indent,paramNames)::_xs -> + // delete the slashes the user typed (they may be indented wrong) + wpfTextView.TextBuffer.Delete(wpfTextView.Caret.Position.BufferPosition.GetContainingLine().Extent.Span) |> ignore + // add the new xmldoc comment + let toInsert = new System.Text.StringBuilder() + toInsert.Append(' ', indent).AppendLine("/// ") + .Append(' ', indent).AppendLine("/// ") + .Append(' ', indent).Append("/// ") |> ignore + paramNames + |> List.iter (fun p -> + toInsert.AppendLine().Append(' ', indent).Append(sprintf "/// " p) |> ignore) + let _newSS = wpfTextView.TextBuffer.Insert(wpfTextView.Caret.Position.BufferPosition.Position, toInsert.ToString()) + // move the caret to between the summary tags + let lastLine = wpfTextView.Caret.Position.BufferPosition.GetContainingLine() + let middleSummaryLine = wpfTextView.TextSnapshot.GetLineFromLineNumber(lastLine.LineNumber - 1 - paramNames.Length) + wpfTextView.Caret.MoveTo(wpfTextView.GetTextViewLineContainingBufferPosition(middleSummaryLine.Start)) |> ignore + with ex -> + Assert.Exception ex + () + } + |> Async.StartImmediate + | Some _ + | None -> () + | _ -> () + if not (isNull nextTarget) then + nextTarget.Exec(&pguidCmdGroup, nCmdID, nCmdexecopt, pvaIn, pvaOut) + else + VSConstants.E_FAIL + + member __.QueryStatus(pguidCmdGroup: byref, cCmds: uint32, prgCmds: OLECMD [], pCmdText: IntPtr) = + if not (isNull nextTarget) then + nextTarget.QueryStatus(ref pguidCmdGroup, cCmds, prgCmds, pCmdText) + else + VSConstants.E_FAIL + +[)>] +[] +[] +type internal XmlDocCommandFilterProvider + [] + (checkerProvider: FSharpCheckerProvider, + projectInfoManager: ProjectInfoManager, + workspace: VisualStudioWorkspaceImpl, + textDocumentFactoryService: ITextDocumentFactoryService, + editorFactory: IVsEditorAdaptersFactoryService) = + interface IWpfTextViewCreationListener with + member __.TextViewCreated(textView) = + match editorFactory.GetViewAdapter(textView) with + | null -> () + | textViewAdapter -> + match textDocumentFactoryService.TryGetTextDocument(textView.TextBuffer) with + | true, doc -> + let commandFilter = XmlDocCommandFilter(textView, doc.FilePath, checkerProvider, projectInfoManager, workspace) + commandFilter.AttachToViewAdapter textViewAdapter + | _ -> () \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 1193b8c4884..7a6de528297 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -60,6 +60,7 @@ +