Permalink
Browse files

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

…e (based on www.fssnip.net).
  • Loading branch information...
1 parent a951e67 commit 6c9a379fb3f32709a75b3e5fecff6c85dd136acf @tpetricek tpetricek committed Jan 25, 2012
View
@@ -0,0 +1,5 @@
+src/FSharp.CodeFormat/bin
+src/FSharp.CodeFormat/obj
+src/FSharp.Markdown/bin
+src/FSharp.Markdown/obj
+*.suo
@@ -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")
@@ -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)
Oops, something went wrong.

0 comments on commit 6c9a379

Please sign in to comment.