Adding F# source code formatting based on F# compiler language servic…

…e (based on www.fssnip.net).

.gitignore

@@ -0,0 +1,5 @@
+src/FSharp.CodeFormat/bin
+src/FSharp.CodeFormat/obj
+src/FSharp.Markdown/bin
+src/FSharp.Markdown/obj
+*.suo

src/FSharp.CodeFormat.Tests/Script.fsx

@@ -0,0 +1,27 @@
+// --------------------------------------------------------------------------------------
+// TODO: Some actual unit tests would be nice
+// --------------------------------------------------------------------------------------
+
+#r @"..\FSharp.CodeFormat\bin\Debug\FSharp.CodeFormat.dll"
+open FSharp.CodeFormat
+open System.Reflection
+
+// Load custom-built F# compiler with joinads
+let asm = Assembly.LoadFile(@"C:\tomas\Binary\FSharp.Extensions\Debug\cli\4.0\bin\FSharp.Compiler.dll")
+
+let agent = CodeFormat.CreateAgent(asm)
+
+let source = @"
+  let foo = 10
+  foo
+"
+
+let snips = 
+  agent.AsyncParseSource("C:\\test.fsx", source.Trim())
+  |> Async.RunSynchronously
+
+let res = CodeFormat.FormatHtml(snips, "fstips")
+res.SnippetsHtml.[0].Html
+
+// Assembly.Load("FSharp.Compiler, Version=2.0.0.0, Culture=neutral, PublicKeyToken=a19089b1c74d0809")
+// Assembly.LoadFile(@"C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\FSharp.Compiler.dll")

src/FSharp.CodeFormat/CodeFormatAgent.fs

@@ -0,0 +1,276 @@
+// --------------------------------------------------------------------------------------
+// F# CodeFormat (CodeFormatAgent.fs)
+// (c) Tomas Petricek, 2012, Available under Apache 2.0 license.
+// --------------------------------------------------------------------------------------
+namespace FSharp.CodeFormat
+
+open System
+open System.IO
+open System.Web
+open System.Text
+open System.Collections.Generic
+
+open FSharp.CodeFormat
+open FSharp.CodeFormat.CommentFilter
+
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.Reflection
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+// --------------------------------------------------------------------------------------
+// ?
+// --------------------------------------------------------------------------------------
+
+module private Helpers = 
+
+  /// Mapping table that translates F# compiler representation to our union
+  let private colorMap =
+    [ TokenColorKind.Comment, TokenKind.Comment
+      TokenColorKind.Identifier, TokenKind.Identifier
+      TokenColorKind.InactiveCode, TokenKind.Inactive
+      TokenColorKind.Keyword, TokenKind.Keyword
+      TokenColorKind.Number, TokenKind.Number
+      TokenColorKind.Operator, TokenKind.Operator
+      TokenColorKind.PreprocessorKeyword, TokenKind.Preprocessor
+      TokenColorKind.String, TokenKind.String
+      TokenColorKind.UpperIdentifier, TokenKind.Identifier ] |> Map.ofSeq
+
+  /// Return the TokenKind corresponding to the specified F# compiler token
+  let getTokenKind key = 
+    defaultArg (Map.tryFind key colorMap) TokenKind.Default
+
+  // Parse command line options - split string by space, but if there is something
+  // enclosed in double quotes "..." then ignore spaces in the quoted text
+  let parseOptions (str:string) = 
+    let rec loop i opts current =
+      let opts = 
+        if i < str.Length && str.[i] <> ' ' then opts
+        else (System.String(current |> List.rev |> Array.ofSeq))::opts
+      if i = str.Length then opts
+      elif str.[i] = ' ' then loop (i+1) opts []
+      elif str.[i] = '"' then
+        let endp = str.IndexOf('"', i+1)
+        let chars = str.Substring(i+1, endp - i - 1) |> List.ofSeq |> List.rev
+        loop (endp + 1) opts (chars @ current)
+      else loop (i + 1) opts (str.[i] :: current)
+
+    loop 0 [] [] |> Array.ofSeq
+
+
+  /// Use the F# compiler's SourceTokenizer to split a snippet (array of strings)
+  /// into a snippet with token information and line numbers.
+  let getTokens file defines (lines:string[]) : Snippet = 
+
+    // Get defined directives
+    let defines = defines |> Option.map (fun (s:string) -> 
+      s.Split([| ' '; ';'; ',' |], StringSplitOptions.RemoveEmptyEntries) |> List.ofSeq)
+    // Create source tokenizer
+    let sourceTok = SourceTokenizer(defaultArg defines [], file)
+
+    // Parse lines using the tokenizer
+    [ let state = ref 0L
+      for n, line in lines |> Seq.zip [ 0 .. lines.Length ] do
+        let tokenizer = sourceTok.CreateLineTokenizer(line)
+        tokenizer.StartNewLine()
+        let rec parseLine() = seq {
+          match tokenizer.ScanToken(!state) with
+          | Some(tok), nstate ->
+              let str = line.Substring(tok.LeftColumn, tok.RightColumn - tok.LeftColumn + 1)
+              yield str, tok
+              state := nstate
+              yield! parseLine()
+          | None, nstate -> state := nstate }
+        yield n, parseLine() |> List.ofSeq ]
+
+  // Count the minimal number of spaces at the beginning of lines
+  // (so that we can remove spaces for indented text)
+  let countStartingSpaces (lines:Snippet) = 
+    [ for l, (toks:_ list) in lines do
+        match toks with
+        | ((text:string), info)::_ when info.TokenName = "WHITESPACE" ->
+            yield text.Length - text.TrimStart([| ' ' |]).Length
+        | [] -> ()
+        | _ -> yield 0 ] |> Seq.min
+
+// --------------------------------------------------------------------------------------
+// Main type that implements parsing and uses F# services
+// --------------------------------------------------------------------------------------
+
+/// Uses agent to handle formatting requests
+type CodeFormatAgent(assembly) = 
+
+  do FSharpCompiler.BindToAssembly(assembly)
+
+  // Get the number of "IDENT" token in the F# compiler
+  // (This is needed when calling compiler, and it varies depending
+  // on the version i.e. when new keywords are added). Use reflection hack!
+  let identToken : int = FSharpCompiler.``Parser.token.Tags``?IDENT
+
+  // Processes a single line of the snippet
+  let processSnippetLine (checkInfo:TypeCheckInfo) (lines:string[]) (line, lineTokens) =
+
+    // Recursive processing of tokens on the line 
+    // (keeps a long identifier 'island')
+    let rec loop island (tokens:SnippetLine) = seq {
+      match tokens with 
+      | [] -> ()
+      | (body, tokenInfo)::rest ->
+        // Update the current identifier island 
+        // (long identifier e.g. Collections.List.map)
+        let island =
+          match tokenInfo.TokenName with
+          | "DOT" -> island         // keep what we have found so far
+          | "IDENT" -> body::island  // add current identifier
+          | _ -> []                 // drop everything - not in island
+
+        // Find tootltip using F# compiler service & the identifier island
+        let tip =
+          // If we're processing an identfier, see if it has any tool tip
+          if (tokenInfo.TokenName = "IDENT") then
+            let island = island |> List.rev
+            let pos = (line, tokenInfo.LeftColumn + 1)
+            let tip = checkInfo.GetDataTipText(pos, lines.[line], island, identToken)
+            match ToolTipReader.tryFormatTip tip with
+            | Some(_) as res -> res
+            | _ when island.Length > 1 ->
+                // Try to find some information about the last part of the identifier 
+                let pos = (line, tokenInfo.LeftColumn + 2)
+                let tip = checkInfo.GetDataTipText(pos, lines.[line], [ body ], identToken)
+                ToolTipReader.tryFormatTip tip
+            | _ -> None
+          else None
+
+        if tokenInfo.TokenName.StartsWith("OMIT") then 
+          // Special OMIT tag - add tool tip stored in token name
+          // (The text immediately follows the keyword "OMIT")
+          yield Omitted(body, tokenInfo.TokenName.Substring(4))       
+        elif tokenInfo.TokenName = "FSI" then
+          // F# Interactive output - return as Output token
+          yield Output(body)
+        else
+          // Lookup token kind & return information about token
+          yield Token(Helpers.getTokenKind tokenInfo.ColorClass, body, tip)
+
+        // Process the rest of the line
+        yield! loop island rest }
+
+    // Process the current line & return info about it
+    Line (loop [] (List.ofSeq lineTokens) |> List.ofSeq)
+
+
+  /// Process snippet
+  let processSnippet checkInfo lines (source:Snippet) =
+    source |> List.map (processSnippetLine checkInfo lines)
+
+// --------------------------------------------------------------------------------------
+
+  // Create an instance of an InteractiveChecker (which does background analysis
+  // in a typical IntelliSense editor integration for F#)
+  let checker = InteractiveChecker.Create(ignore)
+
+  /// Type-checking takes some time and doesn't return information on the
+  /// first call, so this function creates workflow that tries repeatedly
+  let rec getTypeCheckInfo(untypedInfo, file, source, opts) = async {
+    let obs = IsResultObsolete(fun () -> false)
+    let info = checker.TypeCheckSource(untypedInfo, file, 0, source, opts, obs) 
+    match info with
+    | TypeCheckSucceeded(res) when res.TypeCheckInfo.IsSome ->
+        // Succeeded & got results back
+        return res.TypeCheckInfo.Value, res.Errors
+    | _ -> 
+        do! Async.Sleep(500)
+        return! getTypeCheckInfo(untypedInfo, file, source, opts) }
+
+
+  // ------------------------------------------------------------------------------------
+
+  let processSourceCode (file, source, options, defines) = async {
+
+    // Read the source code into an array of lines
+    use reader = new StringReader(source)
+    let sourceLines = 
+      [| let line = ref ""
+         while (line := reader.ReadLine(); line.Value <> null) do
+           yield line.Value |]
+
+    // Get options for a standalone script file (this adds some 
+    // default references and doesn't require full project information)
+    let opts = checker.GetCheckOptionsFromScriptRoot(file, source) 
+
+    // Override default options if the user specified something
+    let opts = 
+      match options with 
+      | Some(str:string) when not(String.IsNullOrEmpty(str)) -> 
+          opts.WithProjectOptions(Helpers.parseOptions str)
+      | _ -> opts
+
+    // Run the first phase - parse source into AST without type information 
+    let untypedInfo = checker.UntypedParse(file, source, opts) 
+    // Run the second phase - perform type checking
+    let! checkInfo, errors = getTypeCheckInfo(untypedInfo, file, source, opts)
+
+    /// Parse source file into a list of lines consisting of tokens 
+    let tokens = Helpers.getTokens file defines sourceLines
+
+    // --------------------------------------------------------------------------------
+    // When type-checking completes and we have a parsed file (as tokens), we can
+    // put the information together - this processes tokens and adds information such
+    // as color and tool tips (for identifiers)
+
+    // Process "omit" meta-comments in the source
+    let source = shrinkOmittedParts tokens |> List.ofSeq
+
+    // Split source into snippets if it contains meta-comments
+    let snippets : NamedSnippet list = 
+      match getSnippets None [] source sourceLines with
+      | [] -> ["Untitled", source]
+      | snippets -> snippets |> List.rev
+
+    // Generate a list of snippets
+    let parsedSnippets = 
+      snippets |> List.map (fun (title, lines) -> 
+        // Process the current snippet
+        let parsed = processSnippet checkInfo sourceLines source
+
+        // Remove additional whitespace from start of lines
+        let spaces = Helpers.countStartingSpaces lines
+        let parsed =  parsed |> List.map (function
+          | Line ((Token(kind, body, tip))::rest) ->
+              let body = body.Substring(spaces)
+              Line ((Token(kind, body, tip))::rest)
+          | line -> line)
+
+        // Return parsed snippet as 'Snippet' value
+        Snippet(title, parsed))
+
+    return parsedSnippets }
+
+  // ------------------------------------------------------------------------------------
+  // Agent that implements the parsing & formatting
+
+  let agent = MailboxProcessor.Start(fun agent -> async {
+    while true do
+      // Receive parameters for the next parsing request
+      let! request, (chnl:AsyncReplyChannel<_>) = agent.Receive()
+      let! res = processSourceCode request
+      chnl.Reply(res |> Array.ofList)
+    })
+
+  /// Parse the source code specified by 'source', assuming that it
+  /// is located in a specified 'file'. Optional arguments can be used
+  /// to give compiler command line options and preprocessor definitions
+  member x.AsyncParseSource(file, source, ?options, ?defines) =
+    agent.PostAndAsyncReply(fun chnl -> (file, source, options, defines), chnl)
+
+  /// Parse the source code specified by 'source', assuming that it
+  /// is located in a specified 'file'. Optional arguments can be used
+  /// to give compiler command line options and preprocessor definitions
+  member x.ParseSourceAsync(file, source, options, defines) =
+    x.AsyncParseSource(file, source, options, defines)
+    |> Async.StartAsTask
+
+  /// Parse the source code specified by 'source', assuming that it
+  /// is located in a specified 'file'. Optional arguments can be used
+  /// to give compiler command line options and preprocessor definitions
+  member x.ParseSource(file, source, ?options, ?defines) =
+    agent.PostAndReply(fun chnl -> (file, source, options, defines), chnl)